snowtify 0.1.0.1 → 0.1.0.2

raw patch · 2 files changed

+35/−26 lines, 2 filesdep −data-default

Dependencies removed: data-default

Files

• snowtify.cabal +2/−2
• src/Main.hs +33/−24

@@ -1,5 +1,5 @@ name:                snowtify-version:             0.1.0.1+version:             0.1.0.2 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@@ -16,9 +16,9 @@ executable snowtify   hs-source-dirs:      src   main-is:             Main.hs+  ghc-options:         -Wall -Wno-name-shadowing -Wno-unused-do-bind -Wno-type-defaults -Wno-orphans -fprint-potential-instances   default-language:    Haskell2010   build-depends:       base >= 4.7 && < 5-                     , data-default                      , either                      , safe                      , safe-exceptions

@@ -3,18 +3,14 @@ module Main (main) where  import Control.Exception.Safe (MonadThrow, SomeException)-import Control.Monad (void, forM, when)+import Control.Monad (void) 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, ExitCode, Pattern) import qualified Data.Text as T-import qualified Data.Text.IO as TIO import qualified Turtle as TT  @@ -51,27 +47,47 @@ notifySucceeding :: Text -> Text -> Shell ExitCode notifySucceeding command result = do   notifySend $ "stack " <> command <> " is succeed"-  whenDef (not $ T.null result) $ notifySend result+  --TODO: Don't work+  notifySections ["warning"] result  -- | Show errors with the notify-daemon 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+  notifySections ["error", "warning"] result+++-- |+-- This is used for judge any section from a result of `stack (build|test)`.+--+-- This value is \1 of "^.*:\w+:\w+: (.+):$".+type SectionWord = Text+++-- |+-- Send sections to the notify-daemon.+-- The sections are cut from a result of `stack (build|test)` with `[SectionWord]`.+notifySections :: [SectionWord] -> Text -> Shell ExitCode+notifySections = ((totalize <$>) .) . (mapM notifySend .) . sections   where-    sections :: Pattern ()-    sections = void $ do+    sections :: [SectionWord] -> Text -> [Text]+    sections sWords result =+      let blobs = TT.cut resultDelimiter result+      in [y | p <- map isItSection sWords, (x,y) <- map twice blobs, p x]++    -- A delimiter for cut result to sections+    resultDelimiter :: Pattern ()+    resultDelimiter = void $ do       TT.newline       TT.spaces       TT.newline -    isErrorSection :: Text -> Bool-    isErrorSection x =-      case headMay $ T.lines x of+    isItSection :: Text -> Text -> Bool+    isItSection it x =+      let it' = it <> ":" -- 'it' is \1 of "^.*:\w+:\w+: (.+):$"+      in case headMay $ T.lines x of         Nothing        -> False-        Just firstLine -> any (== "error:") $ T.words firstLine+        Just firstLine -> any (== it') $ T.words firstLine   -- |@@ -100,12 +116,5 @@ 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+twice :: a -> (a, a)+twice x = (x, x)