azubi 0.2.0.0 → 0.2.0.1

raw patch · 10 files changed

+254/−137 lines, 10 filesdep ~directoryPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: directory

API changes (from Hackage documentation)

Files

• README.md +4/−4
• azubi.cabal +41/−37
• src/Azubi.hs +1/−0
• src/Azubi/Core/StateExecutors/LocalUnixStateExecutor.hs +125/−59
• src/Azubi/Module/Installable.hs +18/−14
• src/Azubi/Module/Runable.hs +2/−2
• src/Azubi/Syntax.hs +3/−3
• test/Test.hs +0/−18
• test/TestCore.hs +16/−0
• test/TestUnixStateExecutor.hs +44/−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.1.0.1-green.svg)](https://github.com/mrVanDalo/azubi/releases/tag/0.1.0.1)+[![Version](https://img.shields.io/badge/version-0.2.0.0-green.svg)](https://github.com/mrVanDalo/azubi/releases/tag/0.1.0.1) [![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) @@ -30,10 +30,10 @@     main :: IO ()     main = azubiMain $ []            & installed (Ebuild "vim")-           & uptodate (Git "git@github.com:mrVanDalo\/azubi.git" "\/dev\/shm\/azubi")-           & installed (Git "git@github.com:mrVanDalo\/azubi-config.git" "\/dev\/shm\/azubi-config")+           & uptodate (Git "git@github.com:mrVanDalo/azubi.git" "/dev/shm/azubi")+           & installed (Git "git@github.com:mrVanDalo/azubi-config.git" "/dev/shm/azubi-config")            & run (Always "touch" ["/dev/shm/run.test"])-           & link "\/dev\/shm\/azubi.link" "\/dev\/shm\/azubi"+           & link "/dev/shm/azubi.link" "/dev/shm/azubi"   call the script to get a help

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.2.0.0+version:             0.2.0.1  -- A short (one-line) description of the package. synopsis:            A simple DevOps tool which will never "reach" enterprice level.@@ -58,19 +58,9 @@                    , GHC == 7.10.1                    , GHC == 8.0.1 --test-suite test-  build-depends:       base       >= 4.7 && < 5-                     , filepath   >=1 && < 2-                     , hspec      >= 2.3--  type:                exitcode-stdio-1.0-  main-is:             Test.hs-  hs-source-dirs:      src test-  default-language:    Haskell2010-  ghc-options:        -Wall-  buildable:           True-+source-repository head+  type:              git+  location:          git@github.com:mrVanDalo/azubi.git  -- executable azubi --  main-is:             main.hs@@ -96,29 +86,43 @@   default-language:    Haskell2010   ghc-options:        -fwarn-incomplete-patterns --- library---   exposed-modules:     Azubi---   other-modules:       Azubi.Commands.File---                      , Azubi.Commands.Install---                      , Azubi.Commands.Git---                      , Azubi.Commands.Run---                      , Azubi.Commands.Existance---                      , Azubi.Core.Command---                      , Azubi.Core.Context---                      , Azubi.Core.Provision---                      , Azubi.Core.Revertable---                      , Azubi.Core.Syntax---                      , Azubi.Render.BashScript---                      , Azubi.Render.Warez---                      , Azubi.Systems.Gentoo---   hs-source-dirs:      oldsrc---   build-depends:       base >=4.7 && < 5---                      , filepath >=1 && < 2---                      , options >= 1.2 && < 2---   default-language:    Haskell2010  -source-repository head-  type:              git-  location:          git@github.com:mrVanDalo/azubi.git+++test-suite test_unix+  build-depends:       base >=4.7 && < 5+                     , filepath >=1 && < 2+                     , options >= 1.2 && < 2+                     , process >=1.4 && < 2+                     , directory >= 1.3.1.0  && < 2+                     , Diff >= 0.3 +                     , unix >= 2.7+                     , hspec      >= 2.3++  type:                exitcode-stdio-1.0+  main-is:             TestUnixStateExecutor.hs+  hs-source-dirs:      src test+  default-language:    Haskell2010+  ghc-options:        -Wall+  buildable:           True++test-suite test_core+  build-depends:       base >=4.7 && < 5+                     , filepath >=1 && < 2+                     , options >= 1.2 && < 2+                     , process >=1.4 && < 2+                     , directory >= 1.3.1.0  && < 2+                     , Diff >= 0.3 +                     , unix >= 2.7+                     , hspec      >= 2.3++  type:                exitcode-stdio-1.0+  main-is:             TestCore.hs+  hs-source-dirs:      src test+  default-language:    Haskell2010+  ghc-options:        -Wall+  buildable:           True++ 

@@ -26,6 +26,7 @@ module Azubi ( State(..)              , Ebuild(..)              , Git(..)+             , GitOption(..)              , RunCommand(..)              , installed              , Installable

@@ -13,8 +13,7 @@  -} -module Azubi.Core.StateExecutors.LocalUnixStateExecutor ( UnixSystem(..)-                                                        , Verbosity(..) ) where+module Azubi.Core.StateExecutors.LocalUnixStateExecutor where  import Azubi.Core.Model import Azubi.Core.StateExecutor@@ -24,8 +23,10 @@ import System.Process import System.Exit -import System.Posix.Files (createSymbolicLink, readSymbolicLink)+import System.Posix.Files (createSymbolicLink) +import System.FilePath.Posix+ import Data.Algorithm.Diff import Data.Algorithm.DiffOutput @@ -48,7 +49,7 @@     executeState systemConfig (State checks commands comment) = do-    runComment' comment+    stateComment' comment     checkResult <- collectCheckResults systemConfig checks     case checkResult of       Yes -> return Fulfilled@@ -59,7 +60,7 @@           Failure -> return Unfulfilled    executeState systemConfig (States check states comment) = do-    runComment' comment+    stateComment' comment     result <- collectCheckResults systemConfig check     case result of       Yes -> return Fulfilled@@ -95,80 +96,94 @@  -- | Run a command runCommand' :: UnixSystem -> Command -> IO CommandResult-runCommand' _ (CreateFolder path) = do-  runComment' $ Just $ "create directory " ++ path+runCommand' systemConfig (CreateFolder path) = do+  logger' systemConfig commandComment' ["create directory ", path]   createDirectoryIfMissing True path   return Success -runCommand' _ (FileContent path content) = do-  runComment' $ Just $ "write content to " ++ path+runCommand' systemConfig (FileContent path content) = do+  logger' systemConfig commandComment' ["write content to ", path]   writeFile path $ unlines content   return Success -runCommand' _ (CreateSymlink path target) = do-  runComment' $ Just $ "create link " ++ path ++ " to " ++ target+runCommand' systemConfig (CreateSymlink path target) = do+  logger' systemConfig commandComment' ["create link", path, " to ", target]   createSymbolicLink target path   return Success  runCommand' systemConfig (Run command arguments comment) = do-  runComment' comment+  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' _ (Remove path) = do-  runComment' (Just $ "remove " ++ path)+runCommand' systemConfig (Remove path) = do+  logger' systemConfig commandComment' ["remove", path]   removePathForcibly path   return Success  --- | show a comment-runComment' :: Maybe Comment -> IO ()-runComment' (Just comment) = echo' [comment]-runComment' Nothing = return ()--- -- | Run a Check runCheck' :: UnixSystem -> Check -> IO CheckResult-runCheck' _ (FolderExists path) = do+runCheck' systemConfig (FolderExists path) = do   behind <- whatIsBehind' path   case behind of-    IsFolder -> return Yes-    _ -> return No+    IsFolder -> do+      logger' systemConfig checkComment' ["FolderExists", path, ": YES"]+      return Yes+    _ -> do+      logger' systemConfig checkComment' ["FolderExists", path, ": NO"]+      return No -runCheck' _ (SymlinkExists path target) = do+runCheck' systemConfig (SymlinkExists path target) = do+  goodTarget <- goodPath' target   behind <- whatIsBehind' path   case behind of-    IsSymlink -> do-      behindTarget <- readSymbolicLink path-      if behindTarget == target-      then return Yes-      else return No-    _ -> return No+    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' _ (HasFileContent path content) = do+runCheck' systemConfig (HasFileContent path content) = do   behind <- whatIsBehind' path   case behind of     IsFile -> checkContent-    _ -> return No+    _ -> do+      logger' systemConfig checkComment' ["HasFileContent", path, ": NO"]+      return No   where     checkContent = do       file <- readFile path       currentContent <- return $ lines file       diff <- return $ getGroupedDiff currentContent content       case diff of-        (Both _ _):[] -> return Yes+        (Both _ _):[] -> do+          logger' systemConfig checkComment' ["HasFileContent", path, ": YES"]+          return Yes         _ -> do-            echo' [ppDiff diff]-            return No+          logger' systemConfig checkComment' ["HasFileContent", path, ": NO"]+          echo' [ppDiff diff]+          return No+ runCheck' systemConfig (Check command args comment) = do-  runComment' comment+  checkComment' comment   result <- runProcess' systemConfig [command] args   case result of-    ExitSuccess -> return Yes-    _ -> return No+    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@@ -178,40 +193,49 @@  runCheck' _ AlwaysYes = return Yes -runCheck' _ (DoesExist path) = do+runCheck' systemConfig (DoesExist path) = do   behind <- whatIsBehind' path   case behind of-    DoesNotExist -> return No-    _ -> return Yes+    DoesNotExist -> do+      logger' systemConfig checkComment' ["DoesExist",path, ": NO"]+      return No+    _ -> do+      logger' systemConfig checkComment' ["DoesExist",path, ": YES"]+      return Yes   data FileType = IsFile               | DoesNotExist-              | IsSymlink+              | IsSymlink Path               | IsFolder-              deriving (Show, Eq, Enum)+              deriving (Show, Eq)  -- | helper function to check whats behind a path whatIsBehind' :: String -> IO FileType-whatIsBehind' path = do-  checkFile <- doesFileExist path-  checkFolder <- doesDirectoryExist path-  case (checkFolder, checkFile) of-    (True,  _) -> return IsFolder-    (False, True) -> do+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-      if checkSymlink-      then return IsSymlink-      else return IsFile-    (False, False) -> return DoesNotExist+      case (checkSymlink, checkFolder) of+        (True, _) -> do+            target <- getSymbolicLinkTarget path+            goodTarget <- goodPath' target+            return $ IsSymlink goodTarget+        (False, True) -> return IsFolder+        (False, False) -> return IsFile +{-| --- | simple print function-echo' :: [String] -> IO ()-echo' text = putStrLn $ unwords $ "[Azubi]":text+run a process and wait until it's finished+return the exit code --- | 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 }@@ -223,4 +247,46 @@         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 () 

@@ -73,7 +73,7 @@   installed (Ebuild package) = State                                [Check "eix" ["--exact", "--nocolor", "--installed", package] (Just $ "check if package " ++ package ++ " is installed")]                                [Run "emerge" [package] (Just $ "installing " ++ package)]-                               Nothing+                               (Just $ "installed " ++ package)   instance Updatable Ebuild where @@ -84,7 +84,7 @@                                   [Run "emerge" [package] (Just $ "upgrade " ++ package)]                                   Nothing                               ]-                              Nothing+                              (Just $ "up to date " ++ package)   @@ -104,27 +104,31 @@ See 'installed'.  -}-data Git = Git RepoUrl Path+data Git = Git RepoUrl Path [GitOption]+data GitOption = Recursive   instance Installable Git where -  installed (Git repository path) = State-                                    [FolderExists path]-                                    [Run "git"-                                      ["clone"-                                      , repository-                                      , path]-                                      (Just $ "cloning " ++ repository ++ " to " ++ path)]-                                    Nothing+  installed (Git repository path options) =+    State+    [FolderExists path]+    [ Run+      "git" ( [ "clone" , repository , path ] ++ (extractCloneOptions options) )+      (Just $ "cloning " ++ repository ++ " to " ++ path)]+    (Just $ "installed (git " ++ path ++ " <- " ++ repository ++ ")")+    where+      extractCloneOptions :: [GitOption] -> [String]+      extractCloneOptions [] = []+      extractCloneOptions (Recursive:xs) = "--recursive" : (extractCloneOptions xs)  instance Updatable Git where -  uptodate (Git repo path) =+  uptodate (Git repo path options) =     States [AlwaysYes]-    [ installed (Git repo path )+    [ installed (Git repo path options)     , run (Always "git" ["--work-tree=" ++ path, "pull"])     ]-    Nothing+    (Just $ "up to date (git " ++ path ++ " <- " ++ repo ++")")  

@@ -31,13 +31,13 @@     [ HasFileContent result fileContent ]     [ Run command arguments $ Just $ unwords $ [ "run command" , command ] ++ arguments     , FileContent result fileContent ]-    Nothing+    (Just $ "run once " ++ command ++ " " ++ (show arguments))  run (Always command arguments) =   State   [ Not AlwaysYes ]   [ Run command arguments $ Just $ unwords $ [ "run command",   command ] ++ arguments ]-  Nothing+  (Just $ "run always " ++ command ++ " " ++ (show arguments))  {-| 

@@ -44,7 +44,7 @@  -} requires :: State -> State -> State-stateA  `requires` stateB = States [AlwaysYes] [stateB, stateA] Nothing+stateA  `requires` stateB = States [Not AlwaysYes] [stateB, stateA] Nothing  {-| @@ -56,7 +56,7 @@  -} submodule :: [State] -> State-submodule states = States [AlwaysYes] states Nothing+submodule states = States [Not AlwaysYes] states Nothing   {-|@@ -87,7 +87,7 @@   [ State [Not $ DoesExist path] [Remove path] Nothing   , State [Not AlwaysYes] [CreateSymlink path target] Nothing   ]-  (Just $ "link " ++ path ++ " to " ++ target)+  (Just $ "link " ++ path ++ " -> " ++ target)  {-| 

@@ -1,18 +0,0 @@--import Test.Hspec--import Azubi.Syntax-import Azubi.Core.Model--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])----stateA :: State-stateA = State [] [Run "echo" ["you"] Nothing] Nothing-stateB :: State-stateB = State [] [Run "echo" ["me"] Nothing] Nothing

@@ -0,0 +1,16 @@++import Test.Hspec++import Azubi.Syntax+import Azubi.Core.Model++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])++stateA :: State+stateA = State [] [Run "echo" ["you"] Nothing] Nothing+stateB :: State+stateB = State [] [Run "echo" ["me"] Nothing] Nothing

@@ -0,0 +1,44 @@++import Test.Hspec++import Azubi.Core.StateExecutors.LocalUnixStateExecutor++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++++folderPath :: String+folderPath = "./test-resources/folder"++filePath :: String+filePath = "./test-resources/file"++linkPath :: String+linkPath = "./test-resources/filelink"++folderLinkPath :: String+folderLinkPath = "./test-resources/folderlink"