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}
| 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
bake :: (Stringy state, Stringy patch, Stringy test) => Oven state patch test -> IO ()
bake = bake_
bake_ :: forall state patch test . (Stringy state, Stringy patch, Stringy test) => Oven state patch test -> IO ()
bake_ oven = do
registerMaster
timeInit
getDataDir
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"
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"