{-# LANGUAGE RecordWildCards, DeriveDataTypeable, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}

-- | Define a continuous integration system.
module Development.Bake.Core.Args(
    bake
    ) where

import System.Console.CmdArgs
import Development.Bake.Core.Type hiding (Client)
import Development.Bake.Core.Client
import Development.Bake.Core.GC
import Development.Bake.Server.Start
import Development.Bake.Core.Send
import Control.Exception.Extra
import General.Extra
import Control.DeepSeq
import System.FilePath
import System.IO.Extra
import System.Directory.Extra
import Control.Monad.Extra
import Control.Applicative
import Data.Either.Extra
import Data.Maybe
import Data.List.Extra
import Data.Tuple.Extra
import Paths_bake
import Prelude


data Bake
    = Server {port :: Port, author :: [Author], timeout :: Double, admin :: String}
    | Client {host :: Host, port :: Port, author :: [Author], name :: String, threads :: Int, provide :: [String], ping :: Double}
    | AddPatch {host :: Host, port :: Port, author :: [Author], name :: String}
    | DelPatch {host :: Host, port :: Port, name :: String}
    | Requeue {host :: Host, port :: Port}
    | SetState {host :: Host, port :: Port, author :: [Author], state :: String}
    | Pause {host :: Host, port :: Port}
    | Unpause {host :: Host, port :: Port}
    | GC {bytes :: Integer, ratio :: Double, days :: Double, dirs :: [FilePath]}
    | Admin {password :: [String]}
    | View {port :: Port, file :: FilePath}
      -- actions sent through from Bake itself
    | RunInit
    | RunUpdate {state :: String, patch :: [String]}
    | RunTest {test :: Maybe String, state :: String, patch :: [String]}
    | RunExtra {state :: String, patch :: [String]}
      deriving (Typeable,Data)


bakeMode = cmdArgsMode $ modes
    [Server{port = 0, author = [], timeout = 10*60, admin = ""}
    ,Client{host = "", threads = 1, name = "", ping = 60, provide = []}
    ,AddPatch{}
    ,DelPatch{}
    ,Requeue{}
    ,SetState{state = ""}
    ,Pause{}
    ,Unpause{}
    ,GC 0 0 7 ([] &= args)
    ,Admin ([] &= args)
    ,View{file = "" &= args}
    ,RunTest def def def
    ,RunInit{}
    ,RunExtra{}
    ,RunUpdate{}
    ] &= verbosity

-- | The entry point to the system. Usually you will define:
--
-- > main = bake myOven
--
--   Where @myOven@ defines details about the server. The program
--   deals with command line arguments, run @--help@ for details.
bake :: (Stringy state, Stringy patch, Stringy test) => Oven state patch test -> IO ()
bake = bake_ -- so the forall's don't show up in Haddock

bake_ :: forall state patch test . (Stringy state, Stringy patch, Stringy test) => Oven state patch test -> IO ()
bake_ oven = do
    registerMaster
    timeInit
    getDataDir -- ensure it gets forced in case you change directory
    x <- cmdArgsRun bakeMode
    let author1 = head $ author x ++ ["unknown"]
    case x of
        Server{..} -> startServer (getPort port) author timeout admin False oven
        View{..} -> do
            when (file == "") $ error "You must pass a file"
            file <- canonicalizePath file
            withTempDir $ \dir -> withCurrentDirectory dir $ do
                createDirectoryIfMissing True $ dir </> "bake-store"
                copyFile file $ dir </> "bake-store" </> "bake.sqlite"
                -- the concrete ensures nothing ever results in a parse error
                startServer (getPort port) [] 100 "" True $ snd $ concrete oven
        Client{..} -> do
            name <- if name /= "" then return name else pick defaultNames
            startClient (getHostPort host port) author1 name threads provide ping oven
        AddPatch{..} -> sendAddPatch (getHostPort host port) author1 =<< check "patch" (undefined :: patch) name
        DelPatch{..} -> sendDelPatch (getHostPort host port) =<< check "patch" (undefined :: patch) name
        Requeue{..} -> sendRequeue (getHostPort host port)
        SetState{..} -> sendSetState (getHostPort host port) author1 state
        Pause{..} -> sendPause (getHostPort host port)
        Unpause{..} -> sendUnpause (getHostPort host port)
        GC{..} -> garbageCollect bytes ratio (days * 24*60*60) (if null dirs then ["."] else dirs)
        Admin{..} -> do
            when (null password) $ putStrLn "Pass passwords on the command line to be suitable for 'server --admin=XXX'"
            forM_ password $ \x -> putStrLn $ "Password " ++ x ++ " requires --admin=" ++ encryptish x
        RunInit -> do
            s <- ovenInit oven
            writeFile ".bake.result" $ stringyTo s
        RunUpdate{..} -> do
            s <- ovenUpdate oven (stringyFrom state) $ map stringyFrom patch
            writeFile ".bake.result" $ stringyTo s
        RunTest{..} -> do
            case test of
                Nothing -> do
                    res <- nubOn stringyTo <$> ovenPrepare oven
                        (stringyFrom state)
                        (map stringyFrom patch)

                    case validTests (ovenTestInfo oven) res of
                        Left err -> fail err
                        Right () -> return ()

                    writeFile ".bake.result" $ show $ map stringyTo res
                Just test -> do
                    testAction $ ovenTestInfo oven $ stringyFrom test
        RunExtra{..} -> do
            res <- ovenPatchExtra oven
                (stringyFrom state)
                (fmap stringyFrom $ listToMaybe patch)
            writeFile ".bake.result" $ show res
    where
        getPort p = if p == 0 then snd $ ovenServer oven else p
        getHostPort h p = (if h == "" then fst $ ovenServer oven else h, getPort p)


check :: Stringy s => String -> s -> String -> IO String
check typ _ x = do
    res <- try_ $ evaluate $ force $ stringyTo $ asTypeOf (stringyFrom x) x
    case res of
        Left err -> error $ "Couldn't stringify the " ++ typ ++ " " ++ show x ++ ", got " ++ show err
        Right v -> return v


defaultNames = words "Simon Lennart Dave Brian Warren Joseph Kevin Ralf Paul John Thomas Mark Erik Alastair Colin Philip"