azubi 0.2.0.2 → 0.2.0.3
raw patch · 15 files changed
+1004/−822 lines, 15 files
Files
- azubi.cabal +6/−4
- src/Azubi.hs +27/−26
- src/Azubi/Core/Boot.hs +40/−41
- src/Azubi/Core/Interpreter.hs +100/−0
- src/Azubi/Core/Interpreter/LocalUnixInterpreter.hs +328/−0
- src/Azubi/Core/Interpreter/UnixUtils.hs +39/−0
- src/Azubi/Core/Model.hs +47/−39
- src/Azubi/Core/StateExecutor.hs +0/−110
- src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs +0/−365
- src/Azubi/Module/Installable.hs +58/−56
- src/Azubi/Module/Runable.hs +66/−23
- src/Azubi/Syntax.hs +44/−52
- test/TestCore.hs +8/−8
- test/TestUnixInterpreter.hs +241/−0
- test/TestUnixStateExecutor.hs +0/−98
azubi.cabal view
@@ -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
src/Azubi.hs view
@@ -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
src/Azubi/Core/Boot.hs view
@@ -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 ..]+ }
+ src/Azubi/Core/Interpreter.hs view
@@ -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
+ src/Azubi/Core/Interpreter/LocalUnixInterpreter.hs view
@@ -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++<https://en.wikipedia.org/wiki/Unix>++-}+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 ()
+ src/Azubi/Core/Interpreter/UnixUtils.hs view
@@ -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
src/Azubi/Core/Model.hs view
@@ -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)
− src/Azubi/Core/StateExecutor.hs
@@ -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-----
− src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs
@@ -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--<https://en.wikipedia.org/wiki/Unix>---}-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 ()-
src/Azubi/Module/Installable.hs view
@@ -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+ , ")"+ ])
src/Azubi/Module/Runable.hs view
@@ -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
src/Azubi/Syntax.hs view
@@ -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)]-
test/TestCore.hs view
@@ -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
+ test/TestUnixInterpreter.hs view
@@ -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"
− test/TestUnixStateExecutor.hs
@@ -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"