azubi 0.2.0.1 → 0.2.0.2

raw patch · 8 files changed

+227/−51 lines, 8 filesdep ~directoryPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• README.md +3/−3
• azubi.cabal +2/−2
• src/Azubi.hs +2/−0
• src/Azubi/Core/Boot.hs +4/−16
• src/Azubi/Core/StateExecutor.hs +26/−1
• src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs +98/−25
• src/Azubi/Syntax.hs +38/−4
• test/TestUnixStateExecutor.hs +54/−0

@@ -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")

@@ -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

@@ -40,6 +40,8 @@              , submodule              , (&)              , azubiMain+             , Command(..)+             , Check(..)              ) where  

@@ -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

@@ -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+   

@@ -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))

@@ -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)+++  {-| 

@@ -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"