-- | Display the difference between two Haskell values,
-- with control over the diff parameters.
module Debug.Diff.Config
    ( Config(..)
    , defConfig
    , diffWith
    , diff
    ) where

import Text.Groom
import Text.Printf
import System.IO
import System.IO.Temp
import System.Process
import System.Exit

-- | Configuration of the diff command
data Config = Config
    { context :: Maybe Int  -- ^ Lines of context, for a unified diff.
    , command :: String     -- ^ Diff command; @colordiff@ by default.
    , args    :: [String]   -- ^ Extra arguments to the diff command.
    } deriving (Eq, Ord, Read, Show)

-- | A default configuration.
defConfig :: Config
defConfig = Config
    { context = Just 3
    , command = "colordiff"
    , args    = [] }

-- | Display the difference between two Haskell values,
-- with control over the diff parameters.
diffWith :: (Show a, Show b) => Config -> a -> b -> IO ()
diffWith cfg x y =
    withSystemTempFile "ddiff_x" $ \px hx ->
    withSystemTempFile "ddiff_y" $ \py hy -> do
        hPutStrLn hx (groom x)
        hClose hx
        hPutStrLn hy (groom y)
        hClose hy
        let ctxArg n = ["-U", show n]
            allArgs = args cfg ++ maybe [] ctxArg (context cfg) ++ [px, py]
        (_, _, _, hdl) <- createProcess (proc (command cfg) allArgs)
        ec <- waitForProcess hdl
        case ec of
            ExitFailure n | n > 1 ->
                hPrintf stderr
                    "debug-diff: command %s with args %s exited with code %d\n"
                    (show (command cfg)) (show allArgs) n
            _ -> return ()

-- | Display a colorized diff between two Haskell values.
diff :: (Show a, Show b) => a -> b -> IO ()
diff = diffWith defConfig