{-# LANGUAGE ViewPatterns #-}
module Main (main) where

import Prelude ()
import Prelude.Compat

import HaskellCI hiding (main)

import Control.Arrow              (first)
import Data.Algorithm.Diff        (PolyDiff (..), getGroupedDiff)
import Distribution.Utils.Generic (fromUTF8BS)
import System.Directory           (setCurrentDirectory)
import System.FilePath            (addExtension)
import Test.Tasty                 (TestName, TestTree, defaultMain, testGroup)
import Test.Tasty.Golden.Advanced (goldenTest)

import qualified Data.ByteString       as BS
import qualified Data.ByteString.Char8 as BS8
import qualified System.Console.ANSI   as ANSI

main :: IO ()
main = do
    setCurrentDirectory "fixtures/"
    defaultMain $ testGroup "fixtures"
        [ fixtureGoldenTest "all-versions"
        , fixtureGoldenTest "empty-line"
        , fixtureGoldenTest "fail-versions"
        , fixtureGoldenTest "irc-channels"
        , fixtureGoldenTest "messy"
        , fixtureGoldenTest "psql"
        , fixtureGoldenTest "travis-patch"
        , fixtureGoldenTest "enabled-jobs"
        , testGroup "copy-fields"
            [ fixtureGoldenTest "copy-fields-all"
            , fixtureGoldenTest "copy-fields-some"
            , fixtureGoldenTest "copy-fields-none"
            ]
        ]

-- |
-- @
-- travisFromConfigFile ::
--    ... => ([String],Options) -> FilePath -> [String] -> Writer [String] m ()
-- @
fixtureGoldenTest :: FilePath -> TestTree
fixtureGoldenTest fp = testGroup fp
    [ fixtureGoldenTest' "travis" travisFromConfigFile
    , fixtureGoldenTest' "github" githubFromConfigFile
    , fixtureGoldenTest' "bash"   bashFromConfigFile
    ]
  where
    -- name acts as extension also
    fixtureGoldenTest' name generate = cabalGoldenTest name outputRef $ do
        (argv, opts') <- makeFlags
        let opts = opts'
              { optInputType      = Just InputTypeProject
              , optConfigMorphism = (\cfg -> cfg { cfgInsertVersion = False}) . optConfigMorphism opts'
              }
        let genConfig = generate argv opts projectfp
        first (fmap (lines . fromUTF8BS)) <$> runDiagnosticsT genConfig
      where
        outputRef = addExtension fp name
        projectfp = fp ++ ".project"

        readArgv :: IO [String]
        readArgv = do
            contents <- readFile $ addExtension fp "args"
            return $ filter (not . null)$ lines contents

        makeFlags :: IO ([String], Options)
        makeFlags = do
            argv <- readArgv
            let argv' = argv ++ [name, projectfp]
            (_fp, opts) <- parseOptions argv'
            return (argv', opts)

cabalGoldenTest
    :: TestName
    -> FilePath
    -> IO (Maybe [String], [String])
    -> TestTree
cabalGoldenTest name outRef act = goldenTest name readGolden (transform <$> act) cmp upd
  where
    readData :: FilePath -> IO [String]
    readData fp = lines . BS8.unpack <$> BS.readFile fp

    transform :: (Maybe [String], [String]) -> [String]
    transform (Nothing, diags) =
        [ "# FAILURE"
        ] ++
        [ "# " ++ w
        | w <- diags
        ]
    transform (Just contents, diags) =
        [ "# SUCCESS"
        ] ++
        [ "# " ++ w
        | w <- diags
        ] ++
        contents

    readGolden = readData outRef

    packData :: [String] -> BS.ByteString
    packData = BS8.pack . unlines

    upd (packData -> contents) = BS.writeFile outRef contents

    cmp x y | x == y = return Nothing
    cmp out1 out2 = return . Just . mconcat $
        [ diff out1 out2
        ]

    diff x y =
        ansiReset -- reset tasty's red color
        ++ unlines (concatMap f (getGroupedDiff x y))

    f (First xs)  = map (withAnsiRed . cons3 '-') xs
    f (Second ys) = map (withAnsiGreen . cons3 '+') ys
    -- we print unchanged lines too.
    -- we trim the contents a little.
    f (Both xs _) = map (cons3 ' ') (shorten xs)

    -- we add three characters, so the changed lines are easier to spot
    cons3 c cs = c : c : c : ' ' : cs

    ansiReset = ANSI.setSGRCode [ ANSI.SetColor ANSI.Foreground ANSI.Dull ANSI.White] -- default color: gray
    ansiRed   = ANSI.setSGRCode [ ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red]
    ansiGreen = ANSI.setSGRCode [ ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Green]

    withAnsiRed s   = ansiRed ++ s ++ ansiReset
    withAnsiGreen s = ansiGreen ++ s ++ ansiReset

    -- for large thunks make ellipsis in between
    shorten xs
        | l < 15    = xs
        | otherwise = as ++ ["..."] ++ drop (l - 10) bs
      where
        l = length xs
        (as, bs) = splitAt 5 xs