packages feed

angel 0.6.1 → 0.6.2

raw patch · 11 files changed

+344/−217 lines, 11 filesdep +tastydep +tasty-hunitdep +tasty-quickcheckdep −hspecdep ~basebuild-type:Customsetup-changed

Dependencies added: tasty, tasty-hunit, tasty-quickcheck

Dependencies removed: hspec

Dependency ranges changed: base

Files

README.md view
@@ -13,10 +13,10 @@  The author is a long-time user of `daemontools` due to its reliability and simplicity; however, `daemontools` is quirky and follows many-unusual conventions.  +unusual conventions. -`angel` is an attempt to recreate `daemontools`'s capabilities (though -not the various bundled utility programs which are still quite useful) +`angel` is an attempt to recreate `daemontools`'s capabilities (though+not the various bundled utility programs which are still quite useful) in a more intuitive and modern unix style.  @@ -24,7 +24,7 @@ -------------  `angel` is driven by a configuration file that contains a list of-program specifications to run.  `angel` assumes every program listed in +program specifications to run.  `angel` assumes every program listed in the specification file should be running at all times.  `angel` starts each program, and optionally sets the program's stdout@@ -35,7 +35,7 @@ If the program dies for any reason, `angel` waits a specified number of seconds (default, 5), then restarts the program. -The `angel` process itself will respond to a HUP signal by +The `angel` process itself will respond to a HUP signal by re-processing its configuration file, and synchronizing the run states with the new configuration.  Specifically: @@ -47,7 +47,7 @@    normal supervision, will be restarted with the updated spec  * If a program has been removed from the configuration file,    the corresponding child process will be sent a TERM signal;-   when it dies, supervision of the process will end, and +   when it dies, supervision of the process will end, and    therefore, it will not be restarted  Safety and Reliability@@ -77,7 +77,7 @@ Building -------- - 1. Install the haskell-platform (or somehow, ghc 7.0 + + 1. Install the haskell-platform (or somehow, ghc 7.6 +     cabal-install)  2. Run `cabal install` in the project root (this directory)  3. Either add the ~/.cabal/bin file to your $PATH or copy@@ -85,8 +85,7 @@  Notes: - * I have not tried building `angel` against ghc 6.10 or earlier;-   6.12, 7.0, 7.2, 7.4, and 7.6 are known to work+ * Angel is recommended to be built on GHC 7.6 and newer.  Configuration and Usage Example -------------------------------@@ -144,7 +143,7 @@  * `exec` is the exact command line to run (required)  * `user` is the user the program will run as (optional, defaults to the    user angel is launched as)- * `stdout` is a path to a file where the program's standard output + * `stdout` is a path to a file where the program's standard output     should be appended (optional, defaults to /dev/null)  * `stderr` is a path to a file where the program's standard error     should be appended (optional, defaults to /dev/null)@@ -184,7 +183,7 @@ Assuming the above configuration was in a file called "example.conf", here's what a shell session might look like: -    jamie@choo:~/random/angel$ angel example.conf +    jamie@choo:~/random/angel$ angel example.conf     [2010/08/24 15:21:22] {main} Angel started     [2010/08/24 15:21:22] {main} Using config file: example.conf     [2010/08/24 15:21:22] {process-monitor} Must kill=0, must start=2@@ -264,7 +263,7 @@ You can run the test suite with  ```-make test+cabal test ```  FAQ@@ -274,7 +273,7 @@  Yes, angel `dup()`s file descriptors and makes effort to safely allow concurrent writes by child programs; you should DEFINITELY-make sure your child program is doing stdout/stderr writes in +make sure your child program is doing stdout/stderr writes in line-buffered mode so this doesn't result in a complete interleaved mess in the log file.
Setup.hs view
@@ -1,3 +1,40 @@ #!/usr/bin/env runhaskell+import Control.Monad import Distribution.Simple-main = defaultMain+import Distribution.Simple.Setup+import Distribution.Simple.Program.Run+import Distribution.Simple.UserHooks+import Distribution.PackageDescription+import Distribution.Verbosity+-- import System.Process+++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+    {+      preTest = myTestHook+    }+++-------------------------------------------------------------------------------+myTestHook+    :: Args+    -> TestFlags+    -> IO HookedBuildInfo+myTestHook _ _ = do+    buildTestFixtures+    return emptyHookedBuildInfo+++-------------------------------------------------------------------------------+buildTestFixtures :: IO ()+buildTestFixtures = do+  runScript "ghc" ["--make", "test/test_jobs/StubbornJob.hs", "-o", "test/test_jobs/StubbornJob"]+  runScript "ghc" ["--make", "test/test_jobs/CompliantJob.hs", "-o", "test/test_jobs/CompliantJob"]+++-------------------------------------------------------------------------------+runScript :: String -> [String] -> IO ()+runScript cmd args = do+  putStrLn $ unwords [cmd, unwords args]+  runProgramInvocation normal $ simpleProgramInvocation cmd args
angel.cabal view
@@ -1,5 +1,5 @@ Name:                angel-Version:             0.6.1+Version:             0.6.2 License:             BSD3 License-file:        LICENSE Author:              Jamie Turner@@ -18,7 +18,7 @@  Stability:           Stable Category:            System-Build-type:          Simple+Build-type:          Custom  Extra-source-files:  README.md                      changelog.md@@ -36,7 +36,7 @@   Hs-Source-Dirs: src   Main-is: Angel/Main.hs -  Build-depends: base >= 4.0 && < 5+  Build-depends: base >= 4.5 && < 5   Build-depends: process >= 1.2.0.0 && < 2.0   Build-depends: mtl   Build-depends: configurator >= 0.1@@ -74,8 +74,10 @@                  Angel.PidFileSpec                  Angel.UtilSpec                  SpecHelper-  Build-Depends:  base-  Build-Depends:  hspec+  Build-Depends: base+  Build-Depends: tasty+  Build-Depends: tasty-hunit+  Build-Depends: tasty-quickcheck   Build-depends: base >= 4.0 && < 5   Build-depends: process >= 1.0 && < 2.0   Build-depends: mtl
changelog.md view
@@ -1,3 +1,6 @@+0.6.2+* Switch to cabal-only build strategy+ 0.6.1 * Fix build for GHC 7.10 by adding FlexibleContexts
test/Angel/ConfigSpec.hs view
@@ -10,131 +10,140 @@  import SpecHelper -spec :: Spec-spec = do-  describe "modifyProg" $ do-    it "modifies exec" $-      modifyProg prog "exec" (String "foo") `shouldBe`-      prog { exec = Just "foo"}--    it "errors for non-string execs" $-      evaluate (modifyProg prog "exec" (Bool True)) `shouldThrow`-      anyErrorCall--    it "modifies delay for positive numbers" $-      modifyProg prog "delay" (Number 1) `shouldBe`-      prog { delay = Just 1}-    it "modifies delay for 0" $-      modifyProg prog "delay" (Number 0) `shouldBe`-      prog { delay = Just 0}-    it "errors on negative delays" $-      evaluate (modifyProg prog "delay" (Number (-1))) `shouldThrow`-      anyErrorCall+spec :: TestTree+spec = testGroup "Angel.Config"+  [+    testGroup "modifyProg"+    [+      testCase "modifies exec" $+        modifyProg prog "exec" (String "foo") @?=+        prog { exec = Just "foo"} -    it "modifies stdout" $-      modifyProg prog "stdout" (String "foo") `shouldBe`-      prog { stdout = Just "foo"}-    it "errors for non-string stdout" $-      evaluate (modifyProg prog "stdout" (Bool True)) `shouldThrow`-      anyErrorCall+    , testCase "errors for non-string execs" $+        evaluate (modifyProg prog "exec" (Bool True)) `shouldThrow`+        anyErrorCall -    it "modifies stderr" $-      modifyProg prog "stderr" (String "foo") `shouldBe`-      prog { stderr = Just "foo"}-    it "errors for non-string stderr" $-      evaluate (modifyProg prog "stderr" (Bool True)) `shouldThrow`-      anyErrorCall+    , testCase "modifies delay for positive numbers" $+        modifyProg prog "delay" (Number 1) @?=+        prog { delay = Just 1}+    , testCase "modifies delay for 0" $+        modifyProg prog "delay" (Number 0) @?=+        prog { delay = Just 0}+    , testCase "errors on negative delays" $+        evaluate (modifyProg prog "delay" (Number (-1))) `shouldThrow`+        anyErrorCall -    it "modifies directory" $-      modifyProg prog "directory" (String "foo") `shouldBe`-      prog { workingDir = Just "foo"}-    it "errors for non-string directory" $-      evaluate (modifyProg prog "directory" (Bool True)) `shouldThrow`-      anyErrorCall+    , testCase "modifies stdout" $+        modifyProg prog "stdout" (String "foo") @?=+        prog { stdout = Just "foo"}+    , testCase "errors for non-string stdout" $+        evaluate (modifyProg prog "stdout" (Bool True)) `shouldThrow`+        anyErrorCall -    it "modifies pidfile" $-      modifyProg prog "pidfile" (String "foo.pid") `shouldBe`-      prog { pidFile = Just "foo.pid"}-    it "errors for non-string path" $-      evaluate (modifyProg prog "pidfile" (Bool True)) `shouldThrow`-      anyErrorCall+    , testCase "modifies stderr" $+        modifyProg prog "stderr" (String "foo") @?=+        prog { stderr = Just "foo"}+    , testCase "errors for non-string stderr" $+        evaluate (modifyProg prog "stderr" (Bool True)) `shouldThrow`+        anyErrorCall -    it "appends env to the empty list" $-      modifyProg prog "env.foo" (String "bar") `shouldBe`-      prog { env = [("foo", "bar")]}-    it "errors for non-string value" $-      evaluate (modifyProg prog "env.foo" (Bool True)) `shouldThrow`-      anyErrorCall-    it "prepends env to an existing list" $-      modifyProg prog { env = [("previous", "value")]} "env.foo" (String "bar") `shouldBe`-      prog { env = [("foo", "bar"), ("previous", "value")]}+    , testCase "modifies directory" $+        modifyProg prog "directory" (String "foo") @?=+        prog { workingDir = Just "foo"}+    , testCase "errors for non-string directory" $+        evaluate (modifyProg prog "directory" (Bool True)) `shouldThrow`+        anyErrorCall -    it "interprets boolean False as Nothing" $-      modifyProg prog "termgrace" (Bool False) `shouldBe`-      prog { termGrace = Nothing }-    it "interprets 0 as Nothing" $-      modifyProg prog "termgrace" (Number 0) `shouldBe`-      prog { termGrace = Nothing }-    it "interprets > 0 as a set termGrace" $-      modifyProg prog "termgrace" (Number 2) `shouldBe`-      prog { termGrace = Just 2 }-    it "interprets boolean True as an error" $-      evaluate (modifyProg prog "termgrace" (Bool True)) `shouldThrow`-      anyErrorCall-    it "interprets negative numbers as an error" $-      evaluate (modifyProg prog "termgrace" (Number (-1))) `shouldThrow`-      anyErrorCall-    it "interprets anything else as an error" $-      evaluate (modifyProg prog "termgrace" (String "yeah")) `shouldThrow`-      anyErrorCall+    , testCase "modifies pidfile" $+        modifyProg prog "pidfile" (String "foo.pid") @?=+        prog { pidFile = Just "foo.pid"}+    , testCase "errors for non-string path" $+        evaluate (modifyProg prog "pidfile" (Bool True)) `shouldThrow`+        anyErrorCall -    it "does nothing for all other cases" $-      modifyProg prog "bogus" (String "foo") `shouldBe`-      prog+    , testCase "appends env to the empty list" $+        modifyProg prog "env.foo" (String "bar") @?=+        prog { env = [("foo", "bar")]}+    , testCase "errors for non-string value" $+        evaluate (modifyProg prog "env.foo" (Bool True)) `shouldThrow`+        anyErrorCall+    , testCase "prepends env to an existing list" $+        modifyProg prog { env = [("previous", "value")]} "env.foo" (String "bar") @?=+        prog { env = [("foo", "bar"), ("previous", "value")]} -  describe "expandByCount" $ do-    it "doesn't affect empty hashes" $-      expandByCount HM.empty `shouldBe`-        HM.empty-    it "doesn't affect hashes without counts" $-      expandByCount (HM.fromList [baseProgPair]) `shouldBe`-        HM.fromList [baseProgPair]-    it "errors on mistyped count field" $-      evaluate (expandByCount (HM.fromList [baseProgPair-                                           , ("prog.count", String "wat")])) `shouldThrow`+    , testCase "interprets boolean False as Nothing" $+        modifyProg prog "termgrace" (Bool False) @?=+        prog { termGrace = Nothing }+    , testCase "interprets 0 as Nothing" $+        modifyProg prog "termgrace" (Number 0) @?=+        prog { termGrace = Nothing }+    , testCase "interprets > 0 as a set termGrace" $+        modifyProg prog "termgrace" (Number 2) @?=+        prog { termGrace = Just 2 }+    , testCase "interprets boolean True as an error" $+        evaluate (modifyProg prog "termgrace" (Bool True)) `shouldThrow`         anyErrorCall-    it "errors on negative count field" $-      evaluate (expandByCount (HM.fromList [ baseProgPair-                                           , ("prog.count", Number (-1))])) `shouldThrow`+    , testCase "interprets negative numbers as an error" $+        evaluate (modifyProg prog "termgrace" (Number (-1))) `shouldThrow`         anyErrorCall-    it "generates no configs with a count of 0" $-      expandByCount (HM.fromList [ baseProgPair-                                 , ("prog.count", Number 0)]) `shouldBe`-        HM.empty-    it "expands with a count of 1" $-      expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 1)]) `shouldBe`-        HM.fromList [ ("prog-1.exec", String "foo")-                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")]-    it "expands with a count of > 1" $-      expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 2)]) `shouldBe`-        HM.fromList [ ("prog-1.exec", String "foo")-                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")-                    , ("prog-2.exec", String "foo")-                    , ("prog-2.env.ANGEL_PROCESS_NUMBER", String "2")]-    it "preserves explicit env variables" $-      expandByCount (HM.fromList [baseProgPair, ("prog.env.FOO", String "bar")]) `shouldBe`-        HM.fromList [ ("prog.exec",    String "foo")-                    , ("prog.env.FOO", String "bar")]-    it "expands pidfiles with a count of 1" $-      expandByCount (HM.fromList [ baseProgPair-                                 , ("prog.count", Number 1)-                                 , ("prog.pidfile", String "foo.pid")]) `shouldBe`-        HM.fromList [ ("prog-1.exec", String "foo")-                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")-                    , ("prog-1.pidfile", String "foo-1.pid")] --TODO: try without expanding if count == 1-  describe "processConfig internal API" $-    it "can parse the example config" $-      shouldReturnRight $ processConfig "example.conf"+    , testCase "interprets anything else as an error" $+        evaluate (modifyProg prog "termgrace" (String "yeah")) `shouldThrow`+        anyErrorCall++    , testCase "does nothing for all other cases" $+        modifyProg prog "bogus" (String "foo") @?=+        prog+    ]++  , testGroup "expandByCount"+    [+      testCase "doesn't affect empty hashes" $+        expandByCount HM.empty @?=+          HM.empty+    , testCase "doesn't affect hashes without counts" $+        expandByCount (HM.fromList [baseProgPair]) @?=+          HM.fromList [baseProgPair]+    , testCase "errors on mistyped count field" $+        evaluate (expandByCount (HM.fromList [baseProgPair+                                             , ("prog.count", String "wat")])) `shouldThrow`+          anyErrorCall+    , testCase "errors on negative count field" $+        evaluate (expandByCount (HM.fromList [ baseProgPair+                                             , ("prog.count", Number (-1))])) `shouldThrow`+          anyErrorCall+    , testCase "generates no configs with a count of 0" $+        expandByCount (HM.fromList [ baseProgPair+                                   , ("prog.count", Number 0)]) @?=+          HM.empty+    , testCase "expands with a count of 1" $+        expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 1)]) @?=+          HM.fromList [ ("prog-1.exec", String "foo")+                      , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")]+    , testCase "expands with a count of > 1" $+        expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 2)]) @?=+          HM.fromList [ ("prog-1.exec", String "foo")+                      , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")+                      , ("prog-2.exec", String "foo")+                      , ("prog-2.env.ANGEL_PROCESS_NUMBER", String "2")]+    , testCase "preserves explicit env variables" $+        expandByCount (HM.fromList [baseProgPair, ("prog.env.FOO", String "bar")]) @?=+          HM.fromList [ ("prog.exec",    String "foo")+                      , ("prog.env.FOO", String "bar")]+    , testCase "expands pidfiles with a count of 1" $+        expandByCount (HM.fromList [ baseProgPair+                                   , ("prog.count", Number 1)+                                   , ("prog.pidfile", String "foo.pid")]) @?=+          HM.fromList [ ("prog-1.exec", String "foo")+                      , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")+                      , ("prog-1.pidfile", String "foo-1.pid")] --TODO: try without expanding if count == 1+    ]++  , testGroup "processConfig internal API"+    [+      testCase "can parse the example config" $+        shouldReturnRight $ processConfig "example.conf"+    ]+  ]   where prog = defaultProgram         baseProgPair = ("prog.exec", String "foo")         shouldReturnRight a = flip shouldSatisfy isRight =<< a
test/Angel/JobSpec.hs view
@@ -18,47 +18,57 @@  import SpecHelper -spec :: Spec-spec =-  describe "killProcess" $ do-    describe "using SoftKill" $ do-      it "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do-        ph <- liftIO launchCompliantJob-        killProcess $ SoftKill "thing" ph Nothing-        liftIO $-          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Exited ExitSuccess)--      it "does not forcefully kill stubborn processes" $ runAngelM dummyOptions $ do-        ph <- liftIO launchStubbornJob-        killProcess $ SoftKill "thing" ph Nothing-        -- stubborn job gets marked as [defunct] here. no idea why. it should be able to survive a SIGTERM-        liftIO $ do-          patientlyGetProcessExitCode ph `shouldReturn` Nothing-          hardKillProcessHandle ph -- cleanup+spec :: TestTree+spec = testGroup "Angel.Jon"+  [+    testGroup "killProcess"+    [+      testGroup "using SoftKill"+      [+        testCase "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do+          ph <- liftIO launchCompliantJob+          killProcess $ SoftKill "thing" ph Nothing+          liftIO $+            patientlyGetProcessExitCode ph `shouldReturn` (Just $ Exited ExitSuccess) -    describe "using HardKill" $ do-      it "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do-        ph <- liftIO launchCompliantJob-        killProcess $ HardKill "thing" ph Nothing 1-        -- Can't geth the exiit status because the life check in Job "uses up" the waitpid-        liftIO $-          patientlyGetProcessExitCode ph `shouldReturn` Nothing-      it "forcefully kills stubborn processes" $ runAngelM dummyOptions $ do-        ph <- liftIO launchStubbornJob-        killProcess $ HardKill "thing" ph Nothing 1-        liftIO $+      , testCase "does not forcefully kill stubborn processes" $ runAngelM dummyOptions $ do+          ph <- liftIO launchStubbornJob+          killProcess $ SoftKill "thing" ph Nothing+          -- stubborn job gets marked as [defunct] here. no idea why. it should be able to survive a SIGTERM+          liftIO $ do+            patientlyGetProcessExitCode ph `shouldReturn` Nothing+            hardKillProcessHandle ph -- cleanup+      ],+      testGroup "using HardKill"+      [+        testCase "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do+          ph <- liftIO launchCompliantJob+          killProcess $ HardKill "thing" ph Nothing 1+          -- Can't geth the exiit status because the life check in Job "uses up" the waitpid+          liftIO $+            patientlyGetProcessExitCode ph `shouldReturn` Nothing+      , testCase "forcefully kills stubborn processes" $ runAngelM dummyOptions $ do+          ph <- liftIO launchStubbornJob+          killProcess $ HardKill "thing" ph Nothing 1+          liftIO $ #if MIN_VERSION_unix(2,7,0)-          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL False)+            patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL False) #else-          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL)+            patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL) #endif-    describe "with a logger" $-      it "cleanly kills well-behaved loggers" $ runAngelM dummyOptions $ do-        ph <- liftIO launchCompliantJob-        lph <- liftIO launchCompliantJob-        killProcess $ SoftKill "thing" ph (Just lph)-        liftIO $-          patientlyGetProcessExitCode lph `shouldReturn` (Just $ Exited ExitSuccess)+      ],+      testGroup "with a logger"+      [+        testCase "cleanly kills well-behaved loggers" $ runAngelM dummyOptions $ do+          ph <- liftIO launchCompliantJob+          lph <- liftIO launchCompliantJob+          killProcess $ SoftKill "thing" ph (Just lph)+          liftIO $+            patientlyGetProcessExitCode lph `shouldReturn` (Just $ Exited ExitSuccess)+      ]+    ]+  ]+  launchCompliantJob :: IO ProcessHandle launchCompliantJob = launchJob "CompliantJob"
test/Angel/LogSpec.hs view
@@ -12,10 +12,15 @@ import SpecHelper  -spec :: Spec-spec = do-  describe "cleanCalendar" $ do-    it "formats the time correctly" $ cleanCalendar dateTime `shouldBe` "2012/09/12 03:14:59"+spec :: TestTree+spec = testGroup "Angel.Log"+  [+    testGroup "cleanCalendar"+    [+      testCase "formats the time correctly" $+        cleanCalendar dateTime @?= "2012/09/12 03:14:59"+    ]+  ]   --where time = CalendarTime 2012 September 12 3 14 59 0 Tuesday 263 "Pacific" -25200 True   where dateTime  = ZonedTime localTime zone         localTime = LocalTime day tod
test/Angel/PidFileSpec.hs view
@@ -14,22 +14,26 @@  import SpecHelper -spec :: Spec-spec =-  describe "startWithPidFile" $ do-    it "creates the pidfile and cleans up" $ do-      startWithPidFile procSpec fileName jogOn $ \_pHandle -> do-        fileShouldExist fileName-        pid <- readFile fileName-        null pid `shouldBe` False-        all isNumber pid `shouldBe` True-      fileShouldNotExist fileName-    it "calls the error callback when pidfile can't be created and re-raises" $ do-      called <- newIORef False-      let onPidError = const $ writeIORef called True-      (res :: Either SomeException ()) <- try $ startWithPidFile procSpec badPidFile jogOn onPidError-      readIORef called `shouldReturn` True-      isLeft res `shouldBe` True+spec :: TestTree+spec = testGroup "Angel.PidFile"+  [+    testGroup "startWithPidFile"+    [+      testCase "creates the pidfile and cleans up" $ do+        startWithPidFile procSpec fileName jogOn $ \_pHandle -> do+          fileShouldExist fileName+          pid <- readFile fileName+          null pid @?= False+          all isNumber pid @?= True+        fileShouldNotExist fileName+    , testCase "calls the error callback when pidfile can't be created and re-raises" $ do+        called <- newIORef False+        let onPidError = const $ writeIORef called True+        (res :: Either SomeException ()) <- try $ startWithPidFile procSpec badPidFile jogOn onPidError+        readIORef called `shouldReturn` True+        isLeft res @?= True+    ]+  ]   where     fileName = "temp.pid"     badPidFile = "/bogus/path/to/pidfile"
test/Angel/UtilSpec.hs view
@@ -8,27 +8,33 @@  import SpecHelper -spec :: Spec-spec = do-  describe "expandPath" $ do-    it "generates the correct path for just a tilde" $ do-      UserEntry { homeDirectory = home } <- getUserEntry-      path <- expandPath "~/foo"-      path `shouldBe` home ++ "/foo"-    it "generates the correct path for tilde with a specific user" $ do-      UserEntry { homeDirectory = home,-                  userName      = user } <- getUserEntry-      path <- expandPath $ "~" ++ user ++ "/foo"-      path `shouldBe` home ++ "/foo"-    it "leaves paths without tildes alone" $ do-      path <- expandPath "/foo"-      path `shouldBe` "/foo"-  describe "split" $ do-    prop "produces no null values" $ \(a :: Char) (xs :: [Char]) ->-      none null $ split a xs-    prop "produces no instances of the split element" $ \(a :: Char) (xs :: [Char]) ->-      none (elem a) $ split a xs-    it "splits" $-      split ' ' "  foo  bar     baz  " `shouldBe` ["foo", "bar", "baz"]+spec :: TestTree+spec = testGroup "Angel.Util"+  [+    testGroup "expandPath"+    [+      testCase "generates the correct path for just a tilde" $ do+        UserEntry { homeDirectory = home } <- getUserEntry+        path <- expandPath "~/foo"+        path @?= home ++ "/foo"+    , testCase "generates the correct path for tilde with a specific user" $ do+        UserEntry { homeDirectory = home,+                    userName      = user } <- getUserEntry+        path <- expandPath $ "~" ++ user ++ "/foo"+        path @?= home ++ "/foo"+    , testCase "leaves paths without tildes alone" $ do+        path <- expandPath "/foo"+        path @?= "/foo"+    ]+  , testGroup "split"+    [+      testProperty "produces no null values" $ \(a :: Char) (xs :: [Char]) ->+        none null $ split a xs+    , testProperty "produces no instances of the split element" $ \(a :: Char) (xs :: [Char]) ->+        none (elem a) $ split a xs+    , testCase "splits" $+        split ' ' "  foo  bar     baz  " @?= ["foo", "bar", "baz"]+    ]+  ]   where getUserEntry = getUserEntryForID =<< getEffectiveUserID         none p = not . any p
test/Spec.hs view
@@ -1,1 +1,23 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+module Main (main) where++-------------------------------------------------------------------------------+import qualified Angel.ConfigSpec+import qualified Angel.JobSpec+import qualified Angel.LogSpec+import qualified Angel.PidFileSpec+import qualified Angel.UtilSpec+-------------------------------------------------------------------------------+import SpecHelper+-------------------------------------------------------------------------------++++main :: IO ()+main = defaultMain $ testGroup "angel"+  [+    Angel.ConfigSpec.spec+  , Angel.JobSpec.spec+  , Angel.LogSpec.spec+  , Angel.PidFileSpec.spec+  , Angel.UtilSpec.spec+  ]
test/SpecHelper.hs view
@@ -1,4 +1,34 @@-module SpecHelper (module X) where+module SpecHelper+    ( module X+    , module SpecHelper+    ) where -import Test.Hspec as X-import Test.Hspec.QuickCheck as X+import Control.Exception+import Test.Tasty as X+import Test.Tasty.HUnit as X+import Test.Tasty.QuickCheck as X++++-------------------------------------------------------------------------------+shouldReturn :: (Show a, Eq a) => IO a -> a -> Assertion+shouldReturn f v = do+  v' <- f+  v' @?= v+++-------------------------------------------------------------------------------+shouldThrow :: Exception e => IO a -> (e -> Bool) -> Assertion+shouldThrow f p = do+  res <- try f+  either (`shouldSatisfy` p) (const $ assertFailure "Did not throw an exception") res+++-------------------------------------------------------------------------------+anyErrorCall :: ErrorCall -> Bool+anyErrorCall = const True+++-------------------------------------------------------------------------------+shouldSatisfy :: (Show a) => a -> (a -> Bool) -> Assertion+shouldSatisfy a p = assertBool ("predicate failed on " ++ show a ) (p a)