snowtify 0.1.0.0 → 0.1.0.1

raw patch · 3 files changed

+60/−23 lines, 3 filesdep +data-default

Dependencies added: data-default

Files

• README.md +1/−1
• snowtify.cabal +2/−1
• src/Main.hs +57/−21

@@ -20,7 +20,7 @@ $ dunst & (dunst is a notify-daemon) $ cd <some haskell project directory>-$ watchexec -w . 'snotify test'+$ watchexec -w . 'snowtify test' (`stack test` results is shown after you update some file) ``` 

@@ -1,5 +1,5 @@ name:                snowtify-version:             0.1.0.0+version:             0.1.0.1 synopsis:            snowtify send your result of `stack build` (`stack test`) to notify-daemon :dog2: description:         snowtify send your result of `stack build` (`stack test`) to notify-daemon :dog2: homepage:            https://github.com/aiya000/hs-snowtify#README.md@@ -18,6 +18,7 @@   main-is:             Main.hs   default-language:    Haskell2010   build-depends:       base >= 4.7 && < 5+                     , data-default                      , either                      , safe                      , safe-exceptions

@@ -3,22 +3,24 @@ module Main (main) where  import Control.Exception.Safe (MonadThrow, SomeException)-import Control.Monad (void, forM_, when)+import Control.Monad (void, forM, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans.Either (runEitherT)+import Data.Default (Default(..)) import Data.Either (isLeft) import Data.List (foldl') import Data.Monoid ((<>)) import Data.Text (Text) import Safe (headMay)-import Turtle (Shell, sh, arguments, procStrictWithErr, ExitCode(..), cut, Pattern, newline, spaces, proc)+import Turtle (Shell, ExitCode, Pattern) import qualified Data.Text as T import qualified Data.Text.IO as TIO+import qualified Turtle as TT   -- | Call `execute` with a haskell-stack command main :: IO ()-main = runEitherT getBuildCommand >>= sh . execute+main = runEitherT getBuildCommand >>= void . TT.sh . execute   where     -- Get a sub command of haskell-stack from CLI arguments.     -- This must be "build" or "test", or empty.@@ -26,7 +28,7 @@     -- If CLI arguments is neither "build" nor "test", throw an exception.     getBuildCommand :: (MonadIO m, MonadThrow m) => m Text     getBuildCommand = do-      args <- headMay <$> liftIO arguments+      args <- headMay <$> liftIO TT.arguments       case args of         Nothing      -> return "build" -- run 'build' by default         Just "test"  -> return "test"@@ -34,34 +36,36 @@         Just unknown -> fail . T.unpack $ "snowtify doesn't know '" <> unknown <> "' command x("  -execute :: Either SomeException Text -> Shell ()-execute (Left err)      = liftIO $ print err+execute :: Either SomeException Text -> Shell ExitCode+execute (Left err)      = notifySend . T.pack $ show err execute (Right command) = do-  (exitCode, out, err) <- procStrictWithErr "stack" [command] ""+  (exitCode, out, err) <- TT.procStrictWithErr "stack" [command] ""   let result = out <> err-  let notifyer = if exitCode == ExitSuccess+  let notifyer = if exitCode == TT.ExitSuccess                     then notifySucceeding                     else notifyErrors-  notifyer result+  notifyer command result   -- | Show succeeding with the notify-daemon-notifySucceeding :: Text -> Shell ()-notifySucceeding = void . notifySend . ("stack test is succeed: " <>)+notifySucceeding :: Text -> Text -> Shell ExitCode+notifySucceeding command result = do+  notifySend $ "stack " <> command <> " is succeed"+  whenDef (not $ T.null result) $ notifySend result  -- | Show errors with the notify-daemon-notifyErrors :: Text -> Shell ()-notifyErrors result = do-  let blobs = cut sections result-  notifySend "stack test is finished with errors"-  forM_ blobs $ \blob ->-    when (isErrorSection blob) . void $ notifySend blob+notifyErrors :: Text -> Text -> Shell ExitCode+notifyErrors command result = do+  let blobs = TT.cut sections result+  notifySend $ "stack " <> command <> " is finished with errors"+  (totalize <$>) . forM blobs $ \blob ->+    whenDef (isErrorSection blob) $ notifySend blob   where     sections :: Pattern ()     sections = void $ do-      newline-      spaces-      newline+      TT.newline+      TT.spaces+      TT.newline      isErrorSection :: Text -> Bool     isErrorSection x =@@ -70,6 +74,38 @@         Just firstLine -> any (== "error:") $ T.words firstLine  +-- |+-- If all `ExitCode` is `ExitSuccess`, return `ExitSuccess`.+-- Otherwise, return `ExitFailure 1`.+totalize :: [ExitCode] -> ExitCode+totalize = exitCode . extremize . sum . map weaken+  where+    weaken :: ExitCode -> Int+    weaken TT.ExitSuccess     = 0+    weaken (TT.ExitFailure n) = n++    extremize :: Int -> Int+    extremize 0 = 0+    extremize _ = 1+++-- | Generalized a value constructor of `ExitCode`+exitCode :: Int -> ExitCode+exitCode 0 = TT.ExitSuccess+exitCode n = TT.ExitFailure n++ -- | Send a message to the notify-daemon notifySend :: Text -> Shell ExitCode-notifySend msg = proc "notify-send" ["snowtify", msg] ""+notifySend msg = TT.proc "notify-send" ["snowtify", msg] ""+++-- | for `whenDef`+instance Default ExitCode where+  def = TT.ExitSuccess+++-- | Simular to `when` but don't forget result+whenDef :: (Applicative f, Default a) => Bool -> f a -> f a+whenDef True f  = f+whenDef False _ = pure def