diff --git a/azubi.cabal b/azubi.cabal --- a/azubi.cabal +++ b/azubi.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.2 +version: 0.2.0.3 -- A short (one-line) description of the package. synopsis: A simple DevOps tool which will never "reach" enterprice level. @@ -57,6 +57,7 @@ , GHC == 7.10.2 , GHC == 7.10.1 , GHC == 8.0.1 + , GHC == 8.0.2 source-repository head type: git @@ -70,9 +71,10 @@ exposed-modules: Azubi other-modules: Azubi.Core.Model Azubi.Core.Boot - Azubi.Core.StateExecutor - Azubi.Core.StateExecutors.LocalUnixStateExecutor + Azubi.Core.Interpreter + Azubi.Core.Interpreter.LocalUnixInterpreter Azubi.Syntax + Azubi.Core.Interpreter.UnixUtils Azubi.Module.Installable Azubi.Module.Runable @@ -101,7 +103,7 @@ , hspec >= 2.3 type: exitcode-stdio-1.0 - main-is: TestUnixStateExecutor.hs + main-is: TestUnixInterpreter.hs hs-source-dirs: src test default-language: Haskell2010 ghc-options: -Wall diff --git a/src/Azubi.hs b/src/Azubi.hs --- a/src/Azubi.hs +++ b/src/Azubi.hs @@ -23,30 +23,31 @@ @ -} -module Azubi ( State(..) - , Ebuild(..) - , Git(..) - , GitOption(..) - , RunCommand(..) - , installed - , Installable - , uptodate - , Updatable - , run - , link - , folderExists - , content - , requires - , submodule - , (&) - , azubiMain - , Command(..) - , Check(..) - ) where - +module Azubi + ( State(..) + , Ebuild(..) + , Git(..) + , GitOption(..) + , RunCommand(..) + , RunResult(..) + , installed + , Installable + , uptodate + , Updatable + , run + , link + , folderExists + , content + , requires + , submodule + , (&) + , azubiMain + , Command(..) + , Check(..) + ) where -import Azubi.Core.Model -import Azubi.Core.Boot -import Azubi.Syntax -import Azubi.Module.Runable -import Azubi.Module.Installable +import Azubi.Core.Boot +import Azubi.Core.Model +import Azubi.Module.Installable +import Azubi.Module.Runable +import Azubi.Syntax diff --git a/src/Azubi/Core/Boot.hs b/src/Azubi/Core/Boot.hs --- a/src/Azubi/Core/Boot.hs +++ b/src/Azubi/Core/Boot.hs @@ -15,11 +15,10 @@ -} module Azubi.Core.Boot where -import Options -import Azubi.Core.Model -import Azubi.Core.StateExecutor -import Azubi.Core.StateExecutors.LocalUnixStateExecutor hiding (runCommand) - +import Azubi.Core.Model +import Azubi.Core.Interpreter +import Azubi.Core.Interpreter.LocalUnixInterpreter hiding ( runCommand ) +import Options {-| The function you should use to get you commands running. @@ -31,50 +30,50 @@ where config context = check (optSystem context) where - check Gentoo = (LocalContext $ UnixSystem verbosity) - check Debian = (LocalContext $ UnixSystem verbosity) - check Ubuntu = (LocalContext $ UnixSystem verbosity) - verbosity = if (optVerbose context) - then Verbose - else Silent - - + check Gentoo = LocalContext $ UnixSystem verbosity + check Debian = LocalContext $ UnixSystem verbosity + check Ubuntu = LocalContext $ UnixSystem verbosity + verbosity = + if optVerbose context + then Verbose + else Silent -extractConfiguration :: AzubiOptions -> [String] -> IO AzubiOptions +extractConfiguration :: AzubiOptions -> [String] -> IO AzubiOptions extractConfiguration opts _ = return opts -data AzubiOptions = AzubiOptions { optVerbose :: Bool - , optSystem :: System - } +data AzubiOptions = AzubiOptions + { optVerbose :: Bool + , optSystem :: System + } instance Options AzubiOptions where - defineOptions = pure AzubiOptions - <*> simpleOption "verbose" False "shows the commands output" - <*> defineOption (optionType_enum "Target System") systemConfig - - - + defineOptions = + pure AzubiOptions <*> + simpleOption "verbose" False "shows the commands output" <*> + defineOption (optionType_enum "Target System") systemConfig -descriptionHelper :: (Show a ) => [String] -> [ a ] -> String -descriptionHelper text (x:xs)= unwords $ text ++ ["[" ++ foldl (\a b -> a ++ ", " ++ (show b)) (show x) xs ++ "]" ] +descriptionHelper :: (Show a) => [String] -> [a] -> String +descriptionHelper text (x:xs) = + unwords $ + text ++ ["[" ++ foldl (\a b -> a ++ ", " ++ show b) (show x) xs ++ "]"] descriptionHelper text [] = unwords text - - - -data System = Gentoo - | Debian - | Ubuntu - deriving (Show, Eq, Bounded, Enum) +data System + = Gentoo + | Debian + | Ubuntu + deriving (Show, Eq, Bounded, Enum) systemConfig :: Option System -> Option System systemConfig opt = - opt{ optionLongFlags = ["system"] - , optionDefault = Gentoo - , optionDescription = - descriptionHelper - [ "The System type the States should" - , "be enforced on. Different Systems have" - , "different commands"] - [Gentoo ..] - } + opt + { optionLongFlags = ["system"] + , optionDefault = Gentoo + , optionDescription = + descriptionHelper + [ "The System type the States should" + , "be enforced on. Different Systems have" + , "different commands" + ] + [Gentoo ..] + } diff --git a/src/Azubi/Core/Interpreter.hs b/src/Azubi/Core/Interpreter.hs new file mode 100644 --- /dev/null +++ b/src/Azubi/Core/Interpreter.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE FlexibleInstances #-} + +{-| + +Module : Azubi.Core.Interpreter +Description : Core low level State evaluation and enforcement +Copyright : (c) Ingolf Wagner, 2017 +License : GPL-3 +Maintainer : azubi@ingolf-wagner.de +Stability : experimental +Portability : POSIX + +'State' must be evaluated and enforced. +This is done by a 'Interpreter'. + +-} +module Azubi.Core.Interpreter where + +import Azubi.Core.Model + +{-| + +should evaluate and enforce given 'State's + +-} +class Interpreter a where + execute :: a -> [State] -> IO () + +{-| + +should create a script. + +todo : write one + +-} +class ScriptInterpreter a where + header :: a -> IO () + footer :: a -> IO () + body :: a -> [State] -> IO () + +-- | wrapper type to prove Haskell +-- there will be now looping. +newtype ScriptExecute a = + ScriptExecute a + +instance ScriptInterpreter a => Interpreter (ScriptExecute a) where + execute (ScriptExecute context) statesToFulfull = do + header context + body context statesToFulfull + footer context + +{-| + +should /run/ the states on the local machine. + +-} +class LocalInterpreter a + -- | a setup function that can be overwritten + -- for stuff that has to be done before + -- processing the states + where + setup :: a -> IO () + setup _ = return () + -- | the function that should execute all states + -- this one has to be implemented + executeState :: a -> State -> IO StateResult + -- | the function called right after processing + -- all of the states which can be overwritten + tearDown :: a -> [StateResult] -> IO () + tearDown _ _ = return () + -- | will be called right before the + -- `exectueState` so you can preprocess the State + -- and remove or add stuff + prePorcessState :: a -> State -> IO State + prePorcessState _ = return + +-- | wrapper type to prove Haskell +-- there will be now looping. +newtype LocalContext a = + LocalContext a + +instance LocalInterpreter a => Interpreter (LocalContext a) where + execute (LocalContext context) statesToFulfull = do + setup context + processedStates <- collectPreprocessed statesToFulfull + results <- collectStateResults processedStates + tearDown context results + where + collectStateResults :: [State] -> IO [StateResult] + collectStateResults [] = return [] + collectStateResults (x:xs) = do + result <- executeState context x + restResults <- collectStateResults xs + return $ result : restResults + collectPreprocessed :: [State] -> IO [State] + collectPreprocessed [] = return [] + collectPreprocessed (x:xs) = do + result <- prePorcessState context x + restResults <- collectPreprocessed xs + return $ result : restResults diff --git a/src/Azubi/Core/Interpreter/LocalUnixInterpreter.hs b/src/Azubi/Core/Interpreter/LocalUnixInterpreter.hs new file mode 100644 --- /dev/null +++ b/src/Azubi/Core/Interpreter/LocalUnixInterpreter.hs @@ -0,0 +1,328 @@ +{-| + +Module : Azubi.Core.Interpreter.LocalUnixInterpreter +Description : 'Interpreter' for Unix machines +Copyright : (c) Ingolf Wagner, 2017 +License : GPL-3 +Maintainer : azubi@ingolf-wagner.de +Stability : experimental +Portability : POSIX + +Run 'State's on a Unix machine. + +-} +module Azubi.Core.Interpreter.LocalUnixInterpreter where + +import Azubi.Core.Model +import Azubi.Core.Interpreter + +import System.Directory + +import System.Exit +import System.Process hiding ( runCommand ) + +import System.Posix.Files ( createSymbolicLink ) + +import Data.Algorithm.Diff +import Data.Algorithm.DiffOutput + +import qualified Azubi.Core.Interpreter.UnixUtils as Util + +{-| + +Unix System like Linux, AIX or OSX + + + +-} +newtype UnixSystem = UnixSystem + { verbose :: Verbosity + } + +data Verbosity + = Verbose + | Silent + +instance LocalInterpreter UnixSystem where + prePorcessState _ state@State {stateChecks = checks, stateCommands = commands} = do + preProcessors <- Util.preProcessors + let checkPreprocessor = prePorcessCheck preProcessors + let commandPreprocessor = preProcessCommand preProcessors + let processedChecks = map checkPreprocessor checks + let processedCommands = map commandPreprocessor commands + return + state {stateChecks = processedChecks, stateCommands = processedCommands} + prePorcessState systemConfig states@States { stateChecks = checksToPreprocess + , subStates = statesToPreProcess + } = do + preProcessors <- Util.preProcessors + let checkPreprocessor = prePorcessCheck preProcessors + let statePreprocessor = prePorcessState systemConfig + let processedChecks = map checkPreprocessor checksToPreprocess + processedSubStates <- mapM statePreprocessor statesToPreProcess + return + states {stateChecks = processedChecks, subStates = processedSubStates} + executeState systemConfig State { stateChecks = checks + , stateCommands = commands + , stateComment = comment + } = do + stateComment' comment + checkResult <- collectCheckResults systemConfig checks + case checkResult of + Yes -> return Fulfilled + No -> do + commandResult <- collectRunResults systemConfig commands + case commandResult of + Success -> return Fulfilled + Failure -> return Unfulfilled + executeState systemConfig (States check states comment) = do + stateComment' comment + result <- collectCheckResults systemConfig check + case result of + Yes -> return Fulfilled + No -> collectStateResults states + where + collectStateResults :: [State] -> IO StateResult + collectStateResults [] = return Fulfilled + collectStateResults (x:xs) = do + result <- executeState systemConfig x + case result of + Unfulfilled -> return Unfulfilled + Fulfilled -> collectStateResults xs + +preProcessCommand :: Util.PreProcessors -> Command -> Command +preProcessCommand _ run@Run {} = run +preProcessCommand preProcessors content@FileContent {filePath = path} = + content {filePath = Util.homeUpdate preProcessors path} +preProcessCommand preProcessors (CreateSymlink path target) = + CreateSymlink + (Util.homeUpdate preProcessors path) + (Util.homeUpdate preProcessors target) +preProcessCommand preProcessors (CreateFolder path) = + CreateFolder (Util.homeUpdate preProcessors path) +preProcessCommand preProcessors (Remove path) = + Remove (Util.homeUpdate preProcessors path) + +prePorcessCheck :: Util.PreProcessors -> Check -> Check +prePorcessCheck _ check@Check {} = check +prePorcessCheck _ SkipChecks = SkipChecks +prePorcessCheck preProcessors (Not check) = + Not (prePorcessCheck preProcessors check) +prePorcessCheck preProcessors content@HasFileContent {pathToCheck = path} = + content {pathToCheck = Util.homeUpdate preProcessors path} +prePorcessCheck preProcessors (SymlinkExists path target) = + SymlinkExists + (Util.homeUpdate preProcessors path) + (Util.homeUpdate preProcessors target) +prePorcessCheck preProcessors (FolderExists path) = + FolderExists (Util.homeUpdate preProcessors path) +prePorcessCheck preProcessors (DoesExist path) = + DoesExist (Util.homeUpdate preProcessors path) + +-- | unroll a number of Check(s) +-- | If one fail, they all fail +collectCheckResults :: UnixSystem -> [Check] -> IO CheckResult +collectCheckResults _ [] = return Yes +collectCheckResults systemConfig (check:rest) = do + result <- runCheck systemConfig check + case result of + Yes -> collectCheckResults systemConfig rest + No -> return No + +-- | unroll a number of Run Commands +-- | if one fail, they all fail +collectRunResults :: UnixSystem -> [Command] -> IO CommandResult +collectRunResults _ [] = return Success +collectRunResults systemConfig (commandToRun:rest) = do + result <- runCommand systemConfig commandToRun + case result of + Success -> collectRunResults systemConfig rest + Failure -> return Failure + +-- | Run a command +runCommand :: UnixSystem -> Command -> IO CommandResult +runCommand systemConfig (CreateFolder path) = do + logger' systemConfig commandComment' ["create directory ", path] + createDirectoryIfMissing True path + return Success +runCommand systemConfig (FileContent path content) = do + logger' systemConfig commandComment' ["write content to ", path] + writeFile path $ unlines content + return Success +runCommand systemConfig (CreateSymlink path target) = do + logger' systemConfig commandComment' ["create link", path, " to ", target] + createSymbolicLink target path + return Success +runCommand systemConfig (Run commandToRun arguments comment) = do + commandComment' comment + logger' + systemConfig + commandComment' + ["run shell command", commandToRun, show arguments] + result <- runProcess' systemConfig commandToRun arguments + case result of + ExitSuccess -> return Success + _ -> return Failure +runCommand systemConfig (Remove path) = do + logger' systemConfig commandComment' ["remove", path] + removePathForcibly path + return Success + +-- | Run a Check +runCheck :: UnixSystem -> Check -> IO CheckResult +runCheck systemConfig (FolderExists path) = do + behind <- whatIsBehind' path + case behind of + IsFolder -> do + logger' systemConfig checkComment' ["FolderExists", path, ": YES"] + return Yes + _ -> do + logger' systemConfig checkComment' ["FolderExists", path, ": NO"] + return No +runCheck systemConfig (SymlinkExists path target) = do + behind <- whatIsBehind' path + case behind of + IsSymlink behindTarget -> + if behindTarget == target + then do + logger' + systemConfig + checkComment' + ["SymlinkExists", path, "->", target, ": YES"] + return Yes + else do + logger' + systemConfig + checkComment' + ["SymlinkExists", path, "->", target, ": NO"] + return No + _ -> do + logger' + systemConfig + checkComment' + ["SymlinkExists", path, "->", target, ": NO"] + return No +runCheck systemConfig (HasFileContent path content) = do + behind <- whatIsBehind' path + case behind of + IsFile -> checkContent + _ -> do + logger' systemConfig checkComment' ["HasFileContent", path, ": NO"] + return No + where + checkContent = do + file <- readFile path + let currentContent = lines file + let diff = getGroupedDiff currentContent content + case diff of + [Both _ _] -> do + logger' systemConfig checkComment' ["HasFileContent", path, ": YES"] + return Yes + _ -> do + logger' systemConfig checkComment' ["HasFileContent", path, ": NO"] + echo' [ppDiff diff] + return No +runCheck systemConfig (Check commandToRun args comment) = do + checkComment' comment + result <- runProcess' systemConfig commandToRun args + case result of + ExitSuccess -> do + logger' + systemConfig + checkComment' + ["Shell Command Check", commandToRun, show args, ": YES"] + return Yes + _ -> do + logger' + systemConfig + checkComment' + ["Shell Command Check", commandToRun, show args, ": NO"] + return No +runCheck systemConfig (Not check) = do + result <- runCheck systemConfig check + case result of + No -> return Yes + Yes -> return No +-- returns `No` to make the State run always the Commands +runCheck _ SkipChecks = return No +runCheck systemConfig (DoesExist path) = do + behind <- whatIsBehind' path + case behind of + DoesNotExist -> do + logger' systemConfig checkComment' ["DoesExist", path, ": NO"] + return No + _ -> do + logger' systemConfig checkComment' ["DoesExist", path, ": YES"] + return Yes + +data FileType + = IsFile + | DoesNotExist + | IsSymlink Path + | IsFolder + deriving (Show, Eq) + +-- | helper function to check whats behind a path +whatIsBehind' :: String -> IO FileType +whatIsBehind' path' = do + preProcessors <- Util.preProcessors + let path = Util.homeUpdate preProcessors path' + exists <- doesPathExist path + if exists + then figureOutFileType path + else return DoesNotExist + where + figureOutFileType path = do + checkFolder <- doesDirectoryExist path + checkSymlink <- pathIsSymbolicLink path + case (checkSymlink, checkFolder) of + (True, _) -> do + target <- getSymbolicLinkTarget path + return $ IsSymlink target + (False, True) -> return IsFolder + (False, False) -> return IsFile + +{-| + +run a process and wait until it's finished +return the exit code + +-} +runProcess' :: UnixSystem -> String -> [String] -> IO ExitCode +runProcess' systemConfig commandToRun args = do + (_, _, _, checkHandle) <- createProcess shellProcess {std_out = stdOutHandle} + waitForProcess checkHandle + where + shellCommand = unwords $ commandToRun : args + shellProcess = shell shellCommand + stdOutHandle :: StdStream + stdOutHandle = + case verbose systemConfig of + Verbose -> Inherit + Silent -> NoStream + +-- | simple print function +echo' :: [String] -> IO () +echo' text = putStrLn $ unwords $ "[Azubi]" : text + +-- | render state comments +stateComment' :: Maybe Comment -> IO () +stateComment' (Just comment) = echo' ["[State]", comment] +stateComment' Nothing = return () + +-- | render command comments +commandComment' :: Maybe Comment -> IO () +commandComment' (Just comment) = echo' ["[Run]", comment] +commandComment' Nothing = return () + +-- | render check comments +checkComment' :: Maybe Comment -> IO () +checkComment' (Just comment) = echo' ["[Check]", comment] +checkComment' Nothing = return () + +logger' :: UnixSystem -> (Maybe Comment -> IO ()) -> [Comment] -> IO () +logger' _ _ [] = return () +logger' systemConfig messager comment = + case verbose systemConfig of + Verbose -> messager $ Just $ unwords comment + Silent -> return () diff --git a/src/Azubi/Core/Interpreter/UnixUtils.hs b/src/Azubi/Core/Interpreter/UnixUtils.hs new file mode 100644 --- /dev/null +++ b/src/Azubi/Core/Interpreter/UnixUtils.hs @@ -0,0 +1,39 @@ +module Azubi.Core.Interpreter.UnixUtils + ( preProcessors + , PreProcessors(..) + ) where + +import System.Directory +import System.FilePath.Posix + +{-| + +A container that holds context and functions +to update States. + +-} +newtype PreProcessors = PreProcessors + { homeUpdate :: String -> String + } + +{-| + +proper constructor. + +-} +preProcessors :: IO PreProcessors +preProcessors = do + home <- getHomeDirectory + return $ PreProcessors $ homeUpdateImpl home + +{-| + +replace ~ at the start of path. +Will not touch ~ inside of a path. + +-} +homeUpdateImpl :: String -> String -> String +homeUpdateImpl home path = + if head (splitDirectories path) == "~" + then joinPath $ home : drop 1 (splitDirectories path) + else path diff --git a/src/Azubi/Core/Model.hs b/src/Azubi/Core/Model.hs --- a/src/Azubi/Core/Model.hs +++ b/src/Azubi/Core/Model.hs @@ -1,4 +1,3 @@ - {-| Module : Azubi.Core.Model @@ -28,10 +27,12 @@ -} module Azubi.Core.Model where - type Path = String + type Target = String + type Argument = String + type Comment = String {-| @@ -46,13 +47,17 @@ @ command -> exit code -> 'CommandResult' @ -} -data Command = Run String [Argument] (Maybe Comment) - | FileContent Path [String] - | CreateSymlink Path Target - | CreateFolder Path - | Remove Path - deriving (Show, Eq) - +data Command + = Run { command :: String + , commandArguments :: [String] + , commandComment :: Maybe String } + | FileContent { filePath :: String + , fileContent :: [String] } + | CreateSymlink { linkPath :: String + , linkTarget :: String } + | CreateFolder { folderPath :: String } + | Remove { removePath :: String } + deriving (Show, Eq) {-| @@ -65,10 +70,10 @@ @ -} -data CommandResult = Success - | Failure - deriving (Show, Enum, Eq) - +data CommandResult + = Success + | Failure + deriving (Show, Enum, Eq) {-| @@ -80,7 +85,7 @@ @ -} -data Check = +data Check {-| Check if command returns exit status @@ -91,28 +96,34 @@ @ -} - Check String [Argument] (Maybe Comment) - | AlwaysYes + = Check { checkCommand :: String + , checkArguments :: [String] + , checkComment :: Maybe String } + -- | Will return `No` to "skip" the Checks. + | SkipChecks -- | Opposite result of a 'Check' | Not Check -- | Check if 'Path' has content - | HasFileContent Path [String] + | HasFileContent { pathToCheck :: String + , contentToCheck :: [String] } -- | Check if a Symbolic link exists to a specific target - | SymlinkExists Path Target + | SymlinkExists { pathToCheck :: String + , targetToCheck :: String } -- | Check if a folder exists - | FolderExists Path + | FolderExists { pathToCheck :: String } -- | Check if something exists at path - | DoesExist Path - deriving (Show, Eq) + | DoesExist { pathToCheck :: String } + deriving (Show, Eq) {-| The result of a 'Check'. -} -data CheckResult = Yes - | No - deriving (Show, Enum, Eq) +data CheckResult + = Yes + | No + deriving (Show, Enum, Eq) {-| @@ -130,20 +141,21 @@ the following 'State's will not be /run/. -} -data State = - +data State -- | State contains checks and commands -- if one command failed -- the following commands will not be -- executed. - State [Check] [Command] (Maybe Comment) - + = State { stateChecks :: [Check] + , stateCommands :: [Command] + , stateComment :: Maybe String } -- | To create depended states -- which should stop being executed -- when a previous state fails - | States [Check] [State] (Maybe Comment) - deriving (Show, Eq) - + | States { stateChecks :: [Check] + , subStates :: [State] + , stateComment :: Maybe String } + deriving (Show, Eq) {-| @@ -154,11 +166,7 @@ * negative 'CheckResult's with negative 'CommandResult's will result in 'Unfulfilled'. -} -data StateResult = Fulfilled - | Unfulfilled - deriving (Show, Eq, Enum) - - - - - +data StateResult + = Fulfilled + | Unfulfilled + deriving (Show, Eq, Enum) diff --git a/src/Azubi/Core/StateExecutor.hs b/src/Azubi/Core/StateExecutor.hs deleted file mode 100644 --- a/src/Azubi/Core/StateExecutor.hs +++ /dev/null @@ -1,110 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} - -{-| - -Module : Azubi.Core.StateExecutor -Description : Core low level State evaluation and enforcement -Copyright : (c) Ingolf Wagner, 2017 -License : GPL-3 -Maintainer : azubi@ingolf-wagner.de -Stability : experimental -Portability : POSIX - -'State' must be evaluated and enforced. -This is done by a 'StateExecutor'. - --} -module Azubi.Core.StateExecutor where - -import Azubi.Core.Model - -{-| - -should evaluate and enforce given 'State's - --} -class StateExecutor a where - execute :: a -> [State] -> IO () - -{-| - -should create a script. - -todo : write one - --} -class ScriptStateExecuter a where - header :: a -> IO () - footer :: a -> IO () - body :: a -> [State] -> IO () - --- | wrapper type to prove Haskell --- there will be now looping. -newtype ScriptExecute a = ScriptExecute a - -instance ScriptStateExecuter a => StateExecutor (ScriptExecute a) where - execute (ScriptExecute context) states = do - header context - body context states - footer context - - - - - -{-| - -should /run/ the states on the local machine. - --} -class LocalStateExecute a where - -- | a setup function that can be overwritten - -- for stuff that has to be done before - -- processing the states - setup :: a -> IO () - setup _ = return () - - -- | the function that should execute all states - -- this one has to be implemented - executeState :: a -> State -> IO StateResult - - -- | the function called right after processing - -- all of the states which can be overwritten - tearDown :: a -> [StateResult] -> IO () - tearDown _ _ = return () - - -- | will be called right before the - -- `exectueState` so you can preprocess the State - -- and remove or add stuff - prePorcessState :: a -> State -> IO (State) - prePorcessState _ state = return state - --- | wrapper type to prove Haskell --- there will be now looping. -newtype LocalContext a = LocalContext a - -instance LocalStateExecute a => StateExecutor (LocalContext a) where - - execute (LocalContext context) states = do - setup context - processedStates <- collectPreprocessed states - results <- collectStateResults processedStates - tearDown context results - where - collectStateResults :: [State] -> IO [StateResult] - collectStateResults [] = return [] - collectStateResults (x:xs) = do - result <- executeState context x - restResults <- collectStateResults xs - return $ result:restResults - collectPreprocessed :: [State] -> IO [State] - collectPreprocessed [] = return [] - collectPreprocessed (x:xs) = do - result <- prePorcessState context x - restResults <- collectPreprocessed xs - return $ result:restResults - - - - - diff --git a/src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs b/src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs deleted file mode 100644 --- a/src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs +++ /dev/null @@ -1,365 +0,0 @@ - -{-| - -Module : Azubi.Core.StateExecutors.LocalUnixStateExecutor -Description : 'StateExecutor' for Unix machines -Copyright : (c) Ingolf Wagner, 2017 -License : GPL-3 -Maintainer : azubi@ingolf-wagner.de -Stability : experimental -Portability : POSIX - -Run 'State's on a Unix machine. - --} - -module Azubi.Core.StateExecutors.LocalUnixStateExecutor where - -import Azubi.Core.Model -import Azubi.Core.StateExecutor - -import System.Directory - -import System.Process hiding (runCommand) -import System.Exit - -import System.Posix.Files (createSymbolicLink) - -import System.FilePath.Posix - -import Data.Algorithm.Diff -import Data.Algorithm.DiffOutput - - - -data Verbosity = Verbose | Silent - -{-| - -Unix System like Linux, AIX or OSX - - - --} -data UnixSystem = UnixSystem { verbose :: Verbosity } - - -data PreProcessors = - PreProcessors { homeUpdate :: (String -> String) } - -homeReplacement :: String -> String -> String -homeReplacement home path = - if ((head (splitDirectories path)) == "~") - then do - joinPath $ home : (drop 1 $ splitDirectories path) - else - path - - -instance LocalStateExecute UnixSystem where - - prePorcessState _ (State checks commands comment) = do - home <- getHomeDirectory - let preProcessors = PreProcessors (homeReplacement home) - let newChecks = (map (prePorcessCheck preProcessors) checks) - let newCommands = (map (preProcessCommand preProcessors) commands) - return $ State newChecks newCommands comment - - prePorcessState systemConfig (States checks states comment) = do - home <- getHomeDirectory - let preProcessors = PreProcessors (homeReplacement home) - let newChecks = (map (prePorcessCheck preProcessors) checks) - newStates <- sequence $ map (prePorcessState systemConfig) states - return $ States newChecks newStates comment - - - executeState systemConfig (State checks commands comment) = do - stateComment' comment - checkResult <- collectCheckResults systemConfig checks - case checkResult of - Yes -> return Fulfilled - No -> do - commandResult <- collectRunResults systemConfig commands - case commandResult of - Success -> return Fulfilled - Failure -> return Unfulfilled - - executeState systemConfig (States check states comment) = do - stateComment' comment - result <- collectCheckResults systemConfig check - case result of - Yes -> return Fulfilled - No -> collectStateResults states - where - collectStateResults :: [State] -> IO StateResult - collectStateResults [] = return Fulfilled - collectStateResults (x:xs) = do - result <- executeState systemConfig x - case result of - Unfulfilled -> return Unfulfilled - Fulfilled -> collectStateResults xs - -preProcessCommand ::PreProcessors -> Command -> Command -preProcessCommand _ (Run command arguments comment) = - Run command arguments comment -preProcessCommand preProcessors (FileContent path content) = - FileContent - ((homeUpdate preProcessors) path) - content -preProcessCommand preProcessors (CreateSymlink path target) = - CreateSymlink - ((homeUpdate preProcessors) path) - ((homeUpdate preProcessors) target) -preProcessCommand preProcessors (CreateFolder path) = - CreateFolder - ((homeUpdate preProcessors) path) - -preProcessCommand preProcessors (Remove path) = - Remove - ((homeUpdate preProcessors) path) - -prePorcessCheck :: PreProcessors -> Check -> Check -prePorcessCheck _ (Check command arguments comment) = - Check command arguments comment -prePorcessCheck _ AlwaysYes = - AlwaysYes -prePorcessCheck preProcessors (Not check) = - Not (prePorcessCheck preProcessors check) -prePorcessCheck preProcessors (HasFileContent path content) = - HasFileContent - ((homeUpdate preProcessors) path) - content -prePorcessCheck preProcessors (SymlinkExists path target) = - SymlinkExists - ((homeUpdate preProcessors) path) - ((homeUpdate preProcessors) target) -prePorcessCheck preProcessors (FolderExists path) = - FolderExists - ((homeUpdate preProcessors) path) -prePorcessCheck preProcessors (DoesExist path) = - DoesExist - ((homeUpdate preProcessors) path) - - --- | unroll a number of Check(s) --- | If one fail, they all fail -collectCheckResults :: UnixSystem -> [Check] -> IO CheckResult -collectCheckResults _ [] = return Yes -collectCheckResults systemConfig (check:rest) = do - result <- runCheck systemConfig check - case result of - Yes -> collectCheckResults systemConfig rest - No -> return No - --- | unroll a number of Run Commands --- | if one fail, they all fail -collectRunResults :: UnixSystem -> [Command] -> IO CommandResult -collectRunResults _ [] = return Success -collectRunResults systemConfig (command:rest) = do - result <- runCommand systemConfig command - case result of - Success -> collectRunResults systemConfig rest - Failure -> return Failure - --- | Run a command -runCommand :: UnixSystem -> Command -> IO CommandResult -runCommand systemConfig (CreateFolder path') = do - path <- goodPath path' - logger' systemConfig commandComment' ["create directory ", path] - createDirectoryIfMissing True path - return Success - -runCommand systemConfig (FileContent path' content) = do - path <- goodPath path' - logger' systemConfig commandComment' ["write content to ", path] - writeFile path $ unlines content - return Success - -runCommand systemConfig (CreateSymlink path' target) = do - path <- goodPath path' - logger' systemConfig commandComment' ["create link", path, " to ", target] - createSymbolicLink target path - return Success - -runCommand systemConfig (Run command arguments comment) = do - commandComment' comment - logger' systemConfig commandComment' ["run shell command", command, show arguments] - result <- runProcess' systemConfig [command] arguments - case result of - ExitSuccess -> return Success - _ -> return Failure - -runCommand systemConfig (Remove path') = do - path <- goodPath path' - logger' systemConfig commandComment' ["remove", path] - removePathForcibly path - return Success - - --- | Run a Check -runCheck :: UnixSystem -> Check -> IO CheckResult -runCheck systemConfig (FolderExists path) = do - behind <- whatIsBehind' path - case behind of - IsFolder -> do - logger' systemConfig checkComment' ["FolderExists", path, ": YES"] - return Yes - _ -> do - logger' systemConfig checkComment' ["FolderExists", path, ": NO"] - return No - -runCheck systemConfig (SymlinkExists path target) = do - goodTarget <- goodPath target - behind <- whatIsBehind' path - case behind of - IsSymlink behindTarget -> do - if behindTarget == goodTarget - then do - logger' systemConfig checkComment' ["SymlinkExists", path, "->", target, ": YES"] - return Yes - else do - logger' systemConfig checkComment' ["SymlinkExists", path, "->", target, ": NO"] - return No - _ -> do - logger' systemConfig checkComment' ["SymlinkExists", path, "->", target, ": NO"] - return No - -runCheck systemConfig (HasFileContent path' content) = do - path <- goodPath path' - behind <- whatIsBehind' path - case behind of - IsFile -> checkContent - _ -> do - logger' systemConfig checkComment' ["HasFileContent", path, ": NO"] - return No - where - checkContent = do - path <- goodPath path' - file <- readFile path - currentContent <- return $ lines file - diff <- return $ getGroupedDiff currentContent content - case diff of - (Both _ _):[] -> do - logger' systemConfig checkComment' ["HasFileContent", path, ": YES"] - return Yes - _ -> do - logger' systemConfig checkComment' ["HasFileContent", path, ": NO"] - echo' [ppDiff diff] - return No - -runCheck systemConfig (Check command args comment) = do - checkComment' comment - result <- runProcess' systemConfig [command] args - case result of - ExitSuccess -> do - logger' systemConfig checkComment' ["Shell Command Check", command , show args , ": YES"] - return Yes - _ -> do - logger' systemConfig checkComment' ["Shell Command Check", command , show args , ": NO"] - return No - -runCheck systemConfig (Not check ) = do - result <- runCheck systemConfig check - case result of - No -> return Yes - Yes -> return No - -runCheck _ AlwaysYes = return Yes - -runCheck systemConfig (DoesExist path) = do - behind <- whatIsBehind' path - case behind of - DoesNotExist -> do - logger' systemConfig checkComment' ["DoesExist",path, ": NO"] - return No - _ -> do - logger' systemConfig checkComment' ["DoesExist",path, ": YES"] - return Yes - - -data FileType = IsFile - | DoesNotExist - | IsSymlink Path - | IsFolder - deriving (Show, Eq) - --- | helper function to check whats behind a path -whatIsBehind' :: String -> IO FileType -whatIsBehind' path' = do - path <- goodPath path' - exists <- doesPathExist path - if exists - then figureOutFileType path - else return DoesNotExist - where - figureOutFileType path = do - checkFolder <- doesDirectoryExist path - checkSymlink <- pathIsSymbolicLink path - case (checkSymlink, checkFolder) of - (True, _) -> do - target <- getSymbolicLinkTarget path - goodTarget <- goodPath target - return $ IsSymlink goodTarget - (False, True) -> return IsFolder - (False, False) -> return IsFile - -{-| - -run a process and wait until it's finished -return the exit code - --} -runProcess' :: UnixSystem -> [String] -> [String] -> IO ExitCode -runProcess' systemConfig command args = do - (_, _ , _ , checkHandle ) <- createProcess (shell $ unwords $ command ++ args ){ std_out = stdOutHandle } - waitForProcess checkHandle - where - stdOutHandle :: StdStream - stdOutHandle = - case (verbose systemConfig) of - Verbose -> Inherit - Silent -> NoStream - -{-| - -corrects the path - -* replaces ~ - --} -goodPath :: String -> IO String -goodPath path = if ((head (splitDirectories path)) == "~") - then do - home <- getHomeDirectory - return $ joinPath $ home : (drop 1 (splitDirectories path)) - else - return path - - --- | simple print function -echo' :: [String] -> IO () -echo' text = putStrLn $ unwords $ "[Azubi]":text - - --- | render state comments -stateComment' :: Maybe Comment -> IO () -stateComment' (Just comment) = echo' ["[State]", comment] -stateComment' Nothing = return () - --- | render command comments -commandComment' :: Maybe Comment -> IO () -commandComment' (Just comment) = echo' ["[Run]", comment] -commandComment' Nothing = return () - --- | render check comments -checkComment' :: Maybe Comment -> IO () -checkComment' (Just comment) = echo' ["[Check]", comment] -checkComment' Nothing = return () - -logger' :: UnixSystem -> (Maybe Comment -> IO ()) -> [Comment] -> IO () -logger' _ _ [] = return () -logger' systemConfig messager comment = - case (verbose systemConfig) of - Verbose -> messager $ Just $ unwords comment - Silent -> return () - diff --git a/src/Azubi/Module/Installable.hs b/src/Azubi/Module/Installable.hs --- a/src/Azubi/Module/Installable.hs +++ b/src/Azubi/Module/Installable.hs @@ -13,11 +13,9 @@ -} module Azubi.Module.Installable where -import Azubi.Core.Model - -import Azubi.Module.Runable - +import Azubi.Core.Model +import Azubi.Module.Runable {-| @@ -25,18 +23,16 @@ instance the Installable class. -} -class Installable a where - +class Installable a {-| install a piece of software on the system. The /piece/ of software should be typed of course. -} + where installed :: a -> State - - {-| Same like 'Installable' but will also @@ -44,19 +40,16 @@ version. -} -class Updatable a where - - +class Updatable a {-| make sure something is installed and up to date. -} + where uptodate :: a -> State - - {-| Ebuild is a Portage package (used by Gentoo and Funtoo). @@ -66,34 +59,31 @@ See 'installed'. -} -data Ebuild = Ebuild String +newtype Ebuild = + Ebuild String instance Installable Ebuild where - - installed (Ebuild package) = State - [Check "eix" ["--exact", "--nocolor", "--installed", package] (Just $ "check if package " ++ package ++ " is installed")] - [Run "emerge" [package] (Just $ "installing " ++ package)] - (Just $ "installed " ++ package) + installed (Ebuild package) = + State + [ Check + "eix" + ["--exact", "--nocolor", "--installed", package] + (Just $ unwords ["check if package ", package, " is installed"]) + ] + [Run "emerge" [package] (Just $ "installing " ++ package)] + (Just $ "installed " ++ package) instance Updatable Ebuild where - - uptodate (Ebuild package) = States [AlwaysYes] - [ installed (Ebuild package) - , State - [Not $ Check "eix" ["--upgrade-", "--nocolor", package] Nothing] - [Run "emerge" [package] (Just $ "upgrade " ++ package)] - Nothing - ] - (Just $ "up to date " ++ package) - - - - - - --- | Url of the repository used by --- git clone -type RepoUrl = String + uptodate (Ebuild package) = + States + [SkipChecks] + [ installed (Ebuild package) + , State + [Not $ Check "eix" ["--upgrade-", "--nocolor", package] Nothing] + [Run "emerge" [package] (Just $ "upgrade " ++ package)] + Nothing + ] + (Just $ "up to date " ++ package) {-| @@ -104,31 +94,43 @@ See 'installed'. -} -data Git = Git RepoUrl Path [GitOption] -data GitOption = Recursive +data Git = Git + { gitRepositoryUrl :: String + , gitRepositoryPath :: String + , gitRepositoryOtions :: [GitOption] + } +data GitOption = + Recursive instance Installable Git where - - installed (Git repository path options) = + installed (Git repoUrl repoPath repoOptions) = State - [FolderExists path] - [ Run - "git" ( [ "clone" , repository , path ] ++ (extractCloneOptions options) ) - (Just $ "cloning " ++ repository ++ " to " ++ path)] - (Just $ "installed (git " ++ path ++ " <- " ++ repository ++ ")") + [FolderExists repoPath] + [ Run + "git" + (["clone", repoUrl, repoPath] ++ extractCloneOptions repoOptions) + (Just $ "cloning " ++ repoUrl ++ " to " ++ repoPath) + ] + (Just $ "installed (git " ++ repoPath ++ " <- " ++ repoUrl ++ ")") where extractCloneOptions :: [GitOption] -> [String] extractCloneOptions [] = [] - extractCloneOptions (Recursive:xs) = "--recursive" : (extractCloneOptions xs) + extractCloneOptions (Recursive:xs) = + "--recursive" : extractCloneOptions xs instance Updatable Git where - - uptodate (Git repo path options) = - States [AlwaysYes] - [ installed (Git repo path options) - , run (Always "git" ["--work-tree=" ++ path, "pull"]) - ] - (Just $ "up to date (git " ++ path ++ " <- " ++ repo ++")") - - + uptodate package = + States + [SkipChecks] + [ installed package + , run (Always "git" ["--work-tree=" ++ gitRepositoryPath package, "pull"]) + ] + (Just $ + unwords + [ "up to date (git " + , gitRepositoryPath package + , " <- " + , gitRepositoryUrl package + , ")" + ]) diff --git a/src/Azubi/Module/Runable.hs b/src/Azubi/Module/Runable.hs --- a/src/Azubi/Module/Runable.hs +++ b/src/Azubi/Module/Runable.hs @@ -11,43 +11,86 @@ -} module Azubi.Module.Runable where -import Azubi.Core.Model +import Azubi.Core.Model +import Azubi.Syntax +import System.FilePath.Posix + {-| creates a 'State' that will run a command of your choice. -} run :: RunCommand -> State -run (Once command arguments result) = - let - fullCommand = unwords $ command : arguments - fileContent = [ "This is a Azubi cache file" - , "You can delete or edit it to make the following command run again" - , "" - , fullCommand ] - in - State - [ HasFileContent result fileContent ] - [ Run command arguments $ Just $ unwords $ [ "run command" , command ] ++ arguments - , FileContent result fileContent ] - (Just $ "run once " ++ command ++ " " ++ (show arguments)) - -run (Always command arguments) = +run (Once commandToRun argumentsOfCommand result) = + let fullCommand = unwords $ commandToRun : argumentsOfCommand + cacheFileContent = + [ "This is a Azubi cache file" + , "You can delete or edit it to make the following command run again" + , "" + , fullCommand + ] + in States + [HasFileContent result cacheFileContent] + [ folderExists (takeDirectory result) + , State + [SkipChecks] + [ Run commandToRun argumentsOfCommand $ + Just $ + unwords $ ["run command", commandToRun] ++ argumentsOfCommand + , FileContent result cacheFileContent + ] + Nothing + ] + (Just $ unwords ["run once ", commandToRun, " ", show argumentsOfCommand]) +run (Always commandToRun argumentsOfCommand) = State - [ Not AlwaysYes ] - [ Run command arguments $ Just $ unwords $ [ "run command", command ] ++ arguments ] - (Just $ "run always " ++ command ++ " " ++ (show arguments)) + [SkipChecks] + [ Run commandToRun argumentsOfCommand $ + Just $ unwords $ ["run command", commandToRun] ++ argumentsOfCommand + ] + (Just $ unwords ["run always ", commandToRun, " ", show argumentsOfCommand]) +run (WithResults commandToRun argumentsOfCommand results) = + States + (map translate results) + [ State + [SkipChecks] + [ Run commandToRun argumentsOfCommand $ + Just $ unwords $ ["run command", commandToRun] ++ argumentsOfCommand + ] + Nothing + ] + (Just $ unwords ["run ", commandToRun, " ", show argumentsOfCommand]) + where + translate :: RunResult -> Check + translate (Creates pathToCreate) = DoesExist pathToCreate + translate (Deletes pathToDelete) = Not $ DoesExist pathToDelete {-| The way a command should be run. See 'run' -} -data RunCommand = +data RunCommand -- | run command every time - Always String [Argument] + = Always { runCommand :: String + , runArguments :: [String] } -- | run command and creates a file to prevent to run again - | Once String [Argument] Path - + | Once { runCommand :: String + , runArguments :: [String] + , cachePath :: String } + -- | run command, with results + -- See 'RunResults' on which results are possible + | WithResults { runCommand :: String + , runArguments :: [String] + , runResults :: [RunResult] } +data RunResult + -- | The command will create a file or folder + -- if there is nothing behind this path + -- this will trigger the command to be run. + = Creates Path + -- | The command will delete a file or folder + -- if there is there something behind the path + -- this will trigger the command to be run. + | Deletes Path diff --git a/src/Azubi/Syntax.hs b/src/Azubi/Syntax.hs --- a/src/Azubi/Syntax.hs +++ b/src/Azubi/Syntax.hs @@ -14,10 +14,10 @@ -} module Azubi.Syntax where -import Azubi.Core.Model -import System.FilePath.Posix - +import Azubi.Core.Model +import System.FilePath.Posix +-- todo : Syntax belongs to core {-| Create a state that ensures that a file in @Path@ will @@ -26,21 +26,15 @@ Every String in the List will be a Line in the File. -} -content :: Path -> [String] -> State -content path fileContent = States - [ HasFileContent path fileContent ] - [ - folderExists (takeDirectory path) - , State - [ Not $ FolderExists path ] - [ Remove path ] - Nothing - , State - [ Not AlwaysYes ] - [ FileContent path fileContent ] - Nothing - ] - (Just $ unwords [ "Content for File" , path ]) +content :: String -> [String] -> State +content path contentToSet = + States + [HasFileContent path contentToSet] + [ folderExists (takeDirectory path) + , State [Not $ FolderExists path] [Remove path] Nothing + , State [SkipChecks] [FileContent path contentToSet] Nothing + ] + (Just $ unwords ["Content for File", path]) {-| @@ -56,7 +50,7 @@ -} requires :: State -> State -> State -stateA `requires` stateB = States [Not AlwaysYes] [stateB, stateA] Nothing +stateA `requires` stateB = States [SkipChecks] [stateB, stateA] Nothing {-| @@ -68,8 +62,7 @@ -} submodule :: [State] -> State -submodule states = States [Not AlwaysYes] states Nothing - +submodule dependingStates = States [SkipChecks] dependingStates Nothing {-| @@ -78,28 +71,30 @@ -} folderExists :: Path -> State folderExists path = - let folders = reverse $ allFolders $ splitDirectories path - in - States [FolderExists path] - (map - (\folder -> - States [FolderExists folder] - [ State [ Not $ DoesExist folder ] - [ Remove folder ] - (Just $ "fuckup " ++ folder) - , State [Not AlwaysYes ] - [CreateFolder folder] - (Just $ "create " ++ folder) - ] - Nothing - ) folders ) - Nothing + let folders = reverse $ allFolders $ reverse $ splitDirectories path + in States + [FolderExists path] + (map + (\folder -> + States + [FolderExists folder] + [ State + [Not $ DoesExist folder] + [Remove folder] + (Just $ "delete folder : " ++ folder) + , State + [SkipChecks] + [CreateFolder folder] + (Just $ "create " ++ folder) + ] + Nothing) + folders) + Nothing where - allFolders [] = [] - allFolders (x:xs) = (joinPath $ x:xs) : (allFolders xs) - - - + allFolders [] = [] + allFolders ["/"] = [] + allFolders ["~"] = [] + allFolders (x:xs) = joinPath (reverse $ x : xs) : allFolders xs {-| @@ -114,14 +109,14 @@ will create a link at @~\/file\/@ pointing to @~\/target\/@ -} -link :: Path -> Path -> State +link :: String -> String -> State link path target = States - [ SymlinkExists path target ] - [ State [Not $ DoesExist path] [Remove path] Nothing - , State [Not AlwaysYes] [CreateSymlink path target] Nothing - ] - (Just $ "link " ++ path ++ " -> " ++ target) + [SymlinkExists path target] + [ State [Not $ DoesExist path] [Remove path] Nothing + , State [SkipChecks] [CreateSymlink path target] Nothing + ] + (Just $ "link " ++ path ++ " -> " ++ target) {-| @@ -135,9 +130,6 @@ -} (&) :: [State] -> State -> [State] -states & state = states ++ [state] - - +previouseStates & state = previouseStates ++ [state] -- (!) :: [State] -> State -> [State] -- states ! state = states ++ [(revertState state)] - diff --git a/test/TestCore.hs b/test/TestCore.hs --- a/test/TestCore.hs +++ b/test/TestCore.hs @@ -1,16 +1,16 @@ - -import Test.Hspec - -import Azubi.Syntax import Azubi.Core.Model +import Azubi.Syntax +import Test.Hspec main :: IO () -main = hspec $ do - describe "requires" $ do - it "should be the same as submoulde for 2 arguments" $ do - (stateA `requires` stateB) `shouldBe` (submodule [stateB, stateA]) +main = + hspec $ do + describe "requires" $ do + it "should be the same as submoulde for 2 arguments" $ do + (stateA `requires` stateB) `shouldBe` submodule [stateB, stateA] stateA :: State stateA = State [] [Run "echo" ["you"] Nothing] Nothing + stateB :: State stateB = State [] [Run "echo" ["me"] Nothing] Nothing diff --git a/test/TestUnixInterpreter.hs b/test/TestUnixInterpreter.hs new file mode 100644 --- /dev/null +++ b/test/TestUnixInterpreter.hs @@ -0,0 +1,241 @@ + +import Test.Hspec +import Azubi +import Azubi.Core.Interpreter +import Azubi.Core.Interpreter.LocalUnixInterpreter +import System.Directory + +verbosity :: Verbosity +verbosity = Verbose + +main :: IO () +main = + hspec $ do + describe "whatIsBehind' should identify" $ do + it "a Folder as IsFolder" $ do + folderType <- whatIsBehind' pathOfFolder + folderType `shouldBe` IsFolder + it "a File as IsFile" $ do + folderType <- whatIsBehind' pathOfFile + folderType `shouldBe` IsFile + it "a Link as IsSymlink " $ do + folderType <- whatIsBehind' pathOfLink + folderType `shouldBe` IsSymlink "./file" + it "a Folder Link as IsSymlink " $ do + folderType <- whatIsBehind' folderLinkPath + folderType `shouldBe` IsSymlink "./folder" + it "~/.cabal as IsFolder" $ do + folderType <- whatIsBehind' "~/.cabal" + folderType `shouldBe` IsFolder + it "/usr as IsFolder" $ do + folderType <- whatIsBehind' "/usr" + folderType `shouldBe` IsFolder + it "/donotexist as DoesNotExist" $ do + noneType <- whatIsBehind' "/donotexist" + noneType `shouldBe` DoesNotExist + describe "folderExists should" $ do + it "return a recursive folder existing check chain" $ do + folderExists "/one/two" `shouldBe` + States + [FolderExists "/one/two"] + [ States + [FolderExists "/one"] + [ State + [Not (DoesExist "/one")] + [Remove "/one"] + (Just "delete folder : /one") + , State [SkipChecks] [CreateFolder "/one"] (Just "create /one") + ] + Nothing + , States + [FolderExists "/one/two"] + [ State + [Not (DoesExist "/one/two")] + [Remove "/one/two"] + (Just "delete folder : /one/two") + , State + [SkipChecks] + [CreateFolder "/one/two"] + (Just "create /one/two") + ] + Nothing + ] + Nothing + folderExists "/one/two/three" `shouldBe` + States + [FolderExists "/one/two/three"] + [ States + [FolderExists "/one"] + [ State + [Not (DoesExist "/one")] + [Remove "/one"] + (Just "delete folder : /one") + , State [SkipChecks] [CreateFolder "/one"] (Just "create /one") + ] + Nothing + , States + [FolderExists "/one/two"] + [ State + [Not (DoesExist "/one/two")] + [Remove "/one/two"] + (Just "delete folder : /one/two") + , State + [SkipChecks] + [CreateFolder "/one/two"] + (Just "create /one/two") + ] + Nothing + , States + [FolderExists "/one/two/three"] + [ State + [Not (DoesExist "/one/two/three")] + [Remove "/one/two/three"] + (Just "delete folder : /one/two/three") + , State + [SkipChecks] + [CreateFolder "/one/two/three"] + (Just "create /one/two/three") + ] + Nothing + ] + Nothing + folderExists "~/one/two/three" `shouldBe` + States + [FolderExists "~/one/two/three"] + [ States + [FolderExists "~/one"] + [ State + [Not (DoesExist "~/one")] + [Remove "~/one"] + (Just "delete folder : ~/one") + , State + [SkipChecks] + [CreateFolder "~/one"] + (Just "create ~/one") + ] + Nothing + , States + [FolderExists "~/one/two"] + [ State + [Not (DoesExist "~/one/two")] + [Remove "~/one/two"] + (Just "delete folder : ~/one/two") + , State + [SkipChecks] + [CreateFolder "~/one/two"] + (Just "create ~/one/two") + ] + Nothing + , States + [FolderExists "~/one/two/three"] + [ State + [Not (DoesExist "~/one/two/three")] + [Remove "~/one/two/three"] + (Just "delete folder : ~/one/two/three") + , State + [SkipChecks] + [CreateFolder "~/one/two/three"] + (Just "create ~/one/two/three") + ] + Nothing + ] + Nothing + describe "basic functions" $ do + it "testing should be set up properly" $ do + removePathForcibly dynamicFolderPath + folderType <- whatIsBehind' dynamicFolderPath + folderType `shouldBe` DoesNotExist + it "should create a file" $ do + let file = (dynamicSubPath "file") + executeIt [content file ["test"]] + folderType <- whatIsBehind' file + folderType `shouldBe` IsFile + it "should create a folder" $ do + let folder = (dynamicSubPath "folder") + executeIt [folderExists folder] + folderType <- whatIsBehind' folder + folderType `shouldBe` IsFolder + it "should create a folder even if it is a file" $ do + let folder = (dynamicSubPath "should/be_a_folder") + executeIt [content folder ["test"]] + executeIt [folderExists folder] + folderType <- whatIsBehind' folder + folderType `shouldBe` IsFolder + it "should create a file even if it is a folder" $ do + let file = (dynamicSubPath "should/be_a_file") + executeIt [folderExists file] + executeIt [content file ["test"]] + folderType <- whatIsBehind' file + folderType `shouldBe` IsFile + describe "preProcessState should" $ do + it "replace ~ in paths" $ do + home <- getHomeDirectory + home `shouldNotBe` "~" + state <- + prePorcessState (UnixSystem verbosity) $ + State [FolderExists "~/test"] [CreateFolder "~/test"] Nothing + state `shouldBe` + State + [FolderExists $ home ++ "/test"] + [CreateFolder $ home ++ "/test"] + Nothing + -- run + describe "run once should" $ do + it "create a file for a successful command" $ do + beforeFile <- whatIsBehind' $ dynamicSubPath "run-once-success" + beforeFile `shouldBe` DoesNotExist + executeIt [run (Once "exit" ["0"] $ dynamicSubPath "run-once-success")] + resultFile <- whatIsBehind' $ dynamicSubPath "run-once-success" + resultFile `shouldBe` IsFile + it "create no file for a failed command" $ do + beforeFile <- whatIsBehind' $ dynamicSubPath "run-once-failure" + beforeFile `shouldBe` DoesNotExist + executeIt [run (Once "exit" ["1"] $ dynamicSubPath "run-once-failure")] + resultFile <- whatIsBehind' $ dynamicSubPath "run-once-failure" + resultFile `shouldBe` DoesNotExist + describe "run which-creates should" $ do + it "should run if outcome file does not exist" $ do + beforeFile <- whatIsBehind' $ dynamicSubPath "run-which-creates-success" + beforeFile `shouldBe` DoesNotExist + executeIt + [ run + (WithResults + "touch" + [dynamicSubPath "run-which-creates-success"] + [Creates $ dynamicSubPath "run-which-creates-success"]) + ] + resultFile <- whatIsBehind' $ dynamicSubPath "run-which-creates-success" + resultFile `shouldBe` IsFile + it "should not run if outcome file does exist" $ do + beforeFile <- whatIsBehind' $ dynamicSubPath "run-which-creates-success" + beforeFile `shouldBe` IsFile + executeIt + [ run + (WithResults + "touch" + [dynamicSubPath "run-which-creates-failure"] + [Creates $ dynamicSubPath "run-which-creates-success"]) + ] + resultFile <- whatIsBehind' $ dynamicSubPath "run-which-creates-failure" + resultFile `shouldBe` DoesNotExist + +executeIt :: [State] -> IO () +executeIt = execute (LocalContext $ UnixSystem verbosity) + +dynamicFolderPath :: String +dynamicFolderPath = "./dynamic-test-folder" + +dynamicSubPath :: String -> String +dynamicSubPath path = dynamicFolderPath ++ "/" ++ path + +pathOfFolder :: String +pathOfFolder = "./test-resources/folder" + +pathOfFile :: String +pathOfFile = "./test-resources/file" + +pathOfLink :: String +pathOfLink = "./test-resources/filelink" + +folderLinkPath :: String +folderLinkPath = "./test-resources/folderlink" diff --git a/test/TestUnixStateExecutor.hs b/test/TestUnixStateExecutor.hs deleted file mode 100644 --- a/test/TestUnixStateExecutor.hs +++ /dev/null @@ -1,98 +0,0 @@ - -import Test.Hspec - -import Azubi.Core.StateExecutors.LocalUnixStateExecutor -import Azubi -import System.Directory -import Azubi.Core.StateExecutor - -verbosity :: Verbosity -verbosity = Verbose - -main :: IO () -main = hspec $ do - - describe "whatIsBehind' should identify" $ do - it "a Folder as IsFolder" $ do - folderType <- whatIsBehind' folderPath - folderType `shouldBe` IsFolder - it "a File as IsFile" $ do - folderType <- whatIsBehind' filePath - folderType `shouldBe` IsFile - it "a Link as IsSymlink " $ do - folderType <- whatIsBehind' linkPath - folderType `shouldBe` IsSymlink "./file" - it "a Folder Link as IsSymlink " $ do - folderType <- whatIsBehind' folderLinkPath - folderType `shouldBe` IsSymlink "./folder" - it "~/.cabal as IsFolder" $ do - folderType <- whatIsBehind' "~/.cabal" - folderType `shouldBe` IsFolder - it "/usr as IsFolder" $ do - folderType <- whatIsBehind' "/usr" - folderType `shouldBe` IsFolder - it "/donotexist as DoesNotExist" $ do - noneType <- whatIsBehind' "/donotexist" - noneType `shouldBe` DoesNotExist - - describe "basic functions" $ do - it "testing should be set up properly" $ do - removePathForcibly dynamicFolderPath - folderType <- whatIsBehind' dynamicFolderPath - folderType `shouldBe` DoesNotExist - it "should create a folder" $ do - executeIt [folderExists dynamicFolderPath] - folderType <- whatIsBehind' dynamicFolderPath - folderType `shouldBe` IsFolder - it "should create a file" $ do - let file = (dynamicSubPath "file") - executeIt [content file ["test"] ] - folderType <- whatIsBehind' file - folderType `shouldBe` IsFile - it "should create a folder" $ do - let folder = (dynamicSubPath "folder") - executeIt [folderExists folder] - folderType <- whatIsBehind' folder - folderType `shouldBe` IsFolder - it "should create a folder even if it is a file" $ do - let folder = (dynamicSubPath "should/be_a_folder") - executeIt [content folder ["test"]] - executeIt [folderExists folder] - folderType <- whatIsBehind' folder - folderType `shouldBe` IsFolder - it "should create a file even if it is a folder" $ do - let file = (dynamicSubPath "should/be_a_file") - executeIt [folderExists file] - executeIt [content file ["test"] ] - folderType <- whatIsBehind' file - folderType `shouldBe` IsFile - - describe "preProcessState should" $ do - it "replace ~ in paths" $ do - home <- getHomeDirectory - home `shouldNotBe` "~" - state <- prePorcessState (UnixSystem verbosity) $ State [FolderExists "~/test"] [CreateFolder "~/test"] Nothing - state `shouldBe` State [FolderExists $ home ++ "/test"] [CreateFolder $ home ++ "/test"] Nothing - - - -executeIt :: [State] -> IO () -executeIt states = execute (LocalContext $ UnixSystem verbosity) states - -dynamicFolderPath :: String -dynamicFolderPath = "./dynamic-test-folder" - -dynamicSubPath :: String -> String -dynamicSubPath path = dynamicFolderPath ++ "/" ++ path - -folderPath :: String -folderPath = "./test-resources/folder" - -filePath :: String -filePath = "./test-resources/file" - -linkPath :: String -linkPath = "./test-resources/filelink" - -folderLinkPath :: String -folderLinkPath = "./test-resources/folderlink"