{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-}
module Main where

import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import qualified Data.ByteString.Char8 as B
import Data.Generics(Data,Typeable)
import Data.Maybe (fromJust)
import Data.List (intercalate, isSuffixOf)
import Data.Word (Word8)
import Network.URI(URI, uriToString, parseURI)
import System.Exit
import System.IO
import System.Process
import Text.Regex.Posix


-- * Generic Argument Handle Types and Classes

type ShowArg = [String] -> [String]

showArg :: String -> [String] -> [String]
showArg arg = ([arg] ++)

showArgs :: (ToArg a) => [a] -> [String] -> [String]
showArgs options = \str -> foldr toArg str options

class ToArg a where
    toArg :: a -> ShowArg

-- * Types for Duplicity

instance ToArg URI where
    toArg uri = showArg $ uriToString id uri ""

instance ToArg FilePath where
    toArg fp = showArg fp

newtype Src a = Src a
      deriving (Read, Show, Eq, Ord, Typeable, Data)

instance (ToArg a) => ToArg (Src a) where
    toArg (Src a) = toArg a

newtype Dest a = Dest a
      deriving (Read, Show, Eq, Ord, Typeable, Data)

instance (ToArg a) => ToArg (Dest a) where
    toArg (Dest a) = toArg a

data Command 
    = Backup Amount [Option] (Src FilePath) (Dest URI)
    | Verify [Option] (Src URI) (Dest FilePath)
      deriving (Eq, Typeable, Data)

instance ToArg Command where
    toArg (Backup amount options src dest) = 
        toArg amount . showArgs options . toArg src . toArg dest
    toArg (Verify options src dest) =
        showArg "verify" . showArgs options . toArg src . toArg dest

data Amount 
    = Full 
    | Incremental
      deriving (Read, Show, Eq, Ord, Enum, Typeable, Data)

instance ToArg Amount where
    toArg Full        = showArg "full"
    toArg Incremental = showArg "incremental"

data Option
    = AllowSourceMismatch
    | NoEncryption
    | Verbosity Word8
      deriving (Read, Show, Eq, Ord, Typeable, Data)

instance ToArg Option where
    toArg AllowSourceMismatch = showArg   "--allow-source-mismatch"
    toArg NoEncryption        = showArg   "--no-encryption"
    toArg (Verbosity lvl)     = showArg $ "-v" ++ show lvl

duplicity = duplicity' "duplicity"

-- duplicity' :: FilePath -> Command -> IO ExitCode
duplicity' procName cmd = 
    do (inh, outh, errh, ph) <- runInteractiveProcess procName (toArg cmd []) Nothing Nothing 
       hClose inh
       outMV <- newEmptyMVar
       errMV <- newEmptyMVar
       out <- forkIO $ B.hGetContents outh >>= putMVar outMV
       err <- forkIO $ B.hGetContents errh >>= putMVar errMV
       ec <- waitForProcess ph
       out <- takeMVar outMV
       err <- takeMVar errMV
       return (out,err,ec)

-- * examples

ex1 = 
    do (out,err, ec) <- 
           duplicity (Verify 
                      [NoEncryption] 
                      (Src (fromJust (parseURI "file:///tmp/duplicity3"))) 
                      (Dest "/home/stepcut/src/duplicity/duplicity-0.5.02"))
       print ec
       putStrLn "out"
       B.putStrLn out
       putStrLn "error"
       B.putStrLn err

updateIfChanged =
    do (out,err, ec) <- 
           duplicity (Verify 
                      [NoEncryption] 
                      (Src (fromJust (parseURI "file:///tmp/duplicity3"))) 
                      (Dest "/home/stepcut/src/duplicity/duplicity-0.5.02"))
       if (ec == ExitFailure 1 && out =~ ".*differences found.*")
          then do (ec, out, err) <- duplicity (Backup Incremental  
                                               [NoEncryption, AllowSourceMismatch] 
                                               (Src "/home/stepcut/src/duplicity/duplicity-0.5.02")
                                               (Dest (fromJust (parseURI "file:///tmp/duplicity3"))))
                  print (ec, out, err)
          else print (ec, out, err)

initial = 
    do (out,err, ec) <- duplicity (Backup Full 
                                   [NoEncryption]
                                   (Src "/home/stepcut/src/duplicity/duplicity-0.5.02")
                                   (Dest (fromJust (parseURI "file:///tmp/duplicity3"))))
       print (out,err,ec)