diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,7 +1,7 @@ # Azubi [![Build Status](https://travis-ci.org/mrVanDalo/azubi.svg?branch=master)](https://travis-ci.org/mrVanDalo/azubi) -[![Version](https://img.shields.io/badge/version-0.2.0.0-green.svg)](https://github.com/mrVanDalo/azubi/releases/tag/0.1.0.1) +[![Documentation](https://img.shields.io/badge/doc-0.2.0.2-green.svg)](http://hackage.haskell.org/package/azubi-0.2.0.2/docs/Azubi.html) [![License](https://img.shields.io/badge/license-gpl-green.svg)](https://www.gnu.org/licenses/gpl-3.0.en.html) [![Join the chat at https://gitter.im/azubi-configuration/Lobby](https://badges.gitter.im/azubi-configuration/Lobby.svg)](https://gitter.im/azubi-configuration/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge) @@ -24,9 +24,9 @@ create a file (e.g. `config.hs`) somewhere you like with the content #!/usr/bin/env runghc - + import Azubi - + main :: IO () main = azubiMain $ [] & installed (Ebuild "vim") 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.1 +version: 0.2.0.2 -- A short (one-line) description of the package. synopsis: A simple DevOps tool which will never "reach" enterprice level. @@ -80,7 +80,7 @@ , filepath >=1 && < 2 , options >= 1.2 && < 2 , process >=1.4 && < 2 - , directory >= 1.3 && < 2 + , directory >= 1.3.1.0 && < 2 , Diff >= 0.3 , unix >= 2.7 default-language: Haskell2010 diff --git a/src/Azubi.hs b/src/Azubi.hs --- a/src/Azubi.hs +++ b/src/Azubi.hs @@ -40,6 +40,8 @@ , submodule , (&) , azubiMain + , Command(..) + , Check(..) ) where 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 @@ -18,7 +18,7 @@ import Options import Azubi.Core.Model import Azubi.Core.StateExecutor -import Azubi.Core.StateExecutors.LocalUnixStateExecutor +import Azubi.Core.StateExecutors.LocalUnixStateExecutor hiding (runCommand) {-| @@ -52,26 +52,14 @@ <*> 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 text [] = unwords text -data Execution = Command - | Dummy - deriving (Show, Eq, Bounded, Enum) - -execConfig :: Option Execution -> Option Execution -execConfig opt = - opt{ optionLongFlags = ["exec"] - , optionDefault = Command - , optionDescription = - descriptionHelper - [ "Type of Execution" - , "which is more or less the way the rules should" - , "System States should be enforced."] - [Command ..] - } data System = Gentoo diff --git a/src/Azubi/Core/StateExecutor.hs b/src/Azubi/Core/StateExecutor.hs --- a/src/Azubi/Core/StateExecutor.hs +++ b/src/Azubi/Core/StateExecutor.hs @@ -58,10 +58,27 @@ -} 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 @@ -70,7 +87,8 @@ execute (LocalContext context) states = do setup context - results <- collectStateResults states + processedStates <- collectPreprocessed states + results <- collectStateResults processedStates tearDown context results where collectStateResults :: [State] -> IO [StateResult] @@ -79,6 +97,13 @@ 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 --- a/src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs +++ b/src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs @@ -20,7 +20,7 @@ import System.Directory -import System.Process +import System.Process hiding (runCommand) import System.Exit import System.Posix.Files (createSymbolicLink) @@ -43,11 +43,36 @@ -} 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 - setup _ = return () - tearDown _ _ = return () + 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 @@ -74,12 +99,54 @@ 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 + result <- runCheck systemConfig check case result of Yes -> collectCheckResults systemConfig rest No -> return No @@ -89,29 +156,32 @@ collectRunResults :: UnixSystem -> [Command] -> IO CommandResult collectRunResults _ [] = return Success collectRunResults systemConfig (command:rest) = do - result <- runCommand' systemConfig command + 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 +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 +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 +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 +runCommand systemConfig (Run command arguments comment) = do commandComment' comment logger' systemConfig commandComment' ["run shell command", command, show arguments] result <- runProcess' systemConfig [command] arguments @@ -119,15 +189,16 @@ ExitSuccess -> return Success _ -> return Failure -runCommand' systemConfig (Remove path) = do +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 +runCheck :: UnixSystem -> Check -> IO CheckResult +runCheck systemConfig (FolderExists path) = do behind <- whatIsBehind' path case behind of IsFolder -> do @@ -137,8 +208,8 @@ logger' systemConfig checkComment' ["FolderExists", path, ": NO"] return No -runCheck' systemConfig (SymlinkExists path target) = do - goodTarget <- goodPath' target +runCheck systemConfig (SymlinkExists path target) = do + goodTarget <- goodPath target behind <- whatIsBehind' path case behind of IsSymlink behindTarget -> do @@ -153,7 +224,8 @@ logger' systemConfig checkComment' ["SymlinkExists", path, "->", target, ": NO"] return No -runCheck' systemConfig (HasFileContent path content) = do +runCheck systemConfig (HasFileContent path' content) = do + path <- goodPath path' behind <- whatIsBehind' path case behind of IsFile -> checkContent @@ -162,6 +234,7 @@ return No where checkContent = do + path <- goodPath path' file <- readFile path currentContent <- return $ lines file diff <- return $ getGroupedDiff currentContent content @@ -174,7 +247,7 @@ echo' [ppDiff diff] return No -runCheck' systemConfig (Check command args comment) = do +runCheck systemConfig (Check command args comment) = do checkComment' comment result <- runProcess' systemConfig [command] args case result of @@ -185,15 +258,15 @@ logger' systemConfig checkComment' ["Shell Command Check", command , show args , ": NO"] return No -runCheck' systemConfig (Not check ) = do - result <- runCheck' systemConfig check +runCheck systemConfig (Not check ) = do + result <- runCheck systemConfig check case result of No -> return Yes Yes -> return No -runCheck' _ AlwaysYes = return Yes +runCheck _ AlwaysYes = return Yes -runCheck' systemConfig (DoesExist path) = do +runCheck systemConfig (DoesExist path) = do behind <- whatIsBehind' path case behind of DoesNotExist -> do @@ -213,7 +286,7 @@ -- | helper function to check whats behind a path whatIsBehind' :: String -> IO FileType whatIsBehind' path' = do - path <- goodPath' path' + path <- goodPath path' exists <- doesPathExist path if exists then figureOutFileType path @@ -225,7 +298,7 @@ case (checkSymlink, checkFolder) of (True, _) -> do target <- getSymbolicLinkTarget path - goodTarget <- goodPath' target + goodTarget <- goodPath target return $ IsSymlink goodTarget (False, True) -> return IsFolder (False, False) -> return IsFile @@ -254,8 +327,8 @@ * replaces ~ -} -goodPath' :: String -> IO String -goodPath' path = if ((head (splitDirectories path)) == "~") +goodPath :: String -> IO String +goodPath path = if ((head (splitDirectories path)) == "~") then do home <- getHomeDirectory return $ joinPath $ home : (drop 1 (splitDirectories path)) diff --git a/src/Azubi/Syntax.hs b/src/Azubi/Syntax.hs --- a/src/Azubi/Syntax.hs +++ b/src/Azubi/Syntax.hs @@ -15,6 +15,7 @@ module Azubi.Syntax where import Azubi.Core.Model +import System.FilePath.Posix {-| @@ -26,9 +27,20 @@ -} content :: Path -> [String] -> State -content path fileContent = State [HasFileContent path fileContent] - [FileContent path fileContent] - (Just $ unwords [ "Content for File" , path ]) +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 ]) {-| @@ -65,7 +77,29 @@ -} folderExists :: Path -> State -folderExists path = State [FolderExists path] [CreateFolder path] Nothing +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 + where + allFolders [] = [] + allFolders (x:xs) = (joinPath $ x:xs) : (allFolders xs) + + + {-| diff --git a/test/TestUnixStateExecutor.hs b/test/TestUnixStateExecutor.hs --- a/test/TestUnixStateExecutor.hs +++ b/test/TestUnixStateExecutor.hs @@ -2,7 +2,13 @@ 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 @@ -29,7 +35,55 @@ 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"