packages feed

cmt 0.7.0.0 → 0.7.1.0

raw patch · 9 files changed

+133/−67 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

- Cmt.Types.Next: DryRun :: Next -> Next
- Cmt.Types.Next: Error :: Text -> Next
+ Cmt.Types.App: Settings :: Bool -> Bool -> Settings
+ Cmt.Types.App: data Settings
+ Cmt.Types.App: defaultSettings :: Settings
+ Cmt.Types.App: instance GHC.Classes.Eq Cmt.Types.App.Settings
+ Cmt.Types.App: instance GHC.Show.Show Cmt.Types.App.Settings
+ Cmt.Types.App: settingsColourize :: Settings -> Bool
+ Cmt.Types.App: settingsDryRun :: Settings -> Bool
+ Cmt.Types.App: type App = ReaderT Settings IO ()
- Cmt.IO.CLI: blank :: IO ()
+ Cmt.IO.CLI: blank :: App
- Cmt.IO.CLI: errorMessage :: Text -> IO ()
+ Cmt.IO.CLI: errorMessage :: Text -> App
- Cmt.IO.CLI: header :: Text -> IO ()
+ Cmt.IO.CLI: header :: Text -> App
- Cmt.IO.CLI: mehssage :: Text -> IO ()
+ Cmt.IO.CLI: mehssage :: Text -> App
- Cmt.IO.CLI: message :: Text -> IO ()
+ Cmt.IO.CLI: message :: Text -> App
- Cmt.Parser.Arguments: parse :: Text -> Next
+ Cmt.Parser.Arguments: parse :: Text -> Either Text (Settings, Next)

Files

README.md view
@@ -199,6 +199,11 @@ cmt --prev ``` +### Colour Output++By default the output uses bash colour codes. You can turn this off using the `--no-color` setting.++ ### Other Options  ```bash
cmt.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.12 name: cmt-version: 0.7.0.0+version: 0.7.1.0 license: BSD3 license-file: LICENSE copyright: Small Hadron Collider / Mark Wales@@ -36,6 +36,7 @@         Cmt.Parser.Config.Parts         Cmt.Parser.Config.PreDefined         Cmt.Parser.Options+        Cmt.Types.App         Cmt.Types.Config         Cmt.Types.Next         Cmt.Utility
src/Cmt.hs view
@@ -21,11 +21,10 @@ import Cmt.Output.Format    (format) import Cmt.Parser.Arguments (parse) import Cmt.Parser.Config    (predefined)+import Cmt.Types.App        (App, settingsDryRun) import Cmt.Types.Config     (Config, Outputs) import Cmt.Types.Next       (Next (..)) -type App = ReaderT Bool IO ()- helpText :: Text helpText = decodeUtf8 $(embedFile "templates/usage.txt") @@ -33,18 +32,17 @@ backup = ".cmt.bkp"  failure :: Text -> App-failure msg = lift (errorMessage msg >> exitFailure)+failure msg = errorMessage msg >> lift exitFailure  dryRun :: Text -> App-dryRun txt =-    lift $ do-        header "Result"-        blank-        message txt-        blank-        writeFile backup (encodeUtf8 txt)-        mehssage "run: cmt --prev to commit"-        exitSuccess+dryRun txt = do+    header "Result"+    blank+    message txt+    blank+    lift $ writeFile backup (encodeUtf8 txt)+    mehssage "run: cmt --prev to commit"+    lift $ exitSuccess  commitRun :: Text -> App commitRun txt = do@@ -57,7 +55,7 @@  send :: Text -> App send txt = do-    dry <- ask+    dry <- asks settingsDryRun     bool commitRun dryRun dry txt  display :: Either Text (Config, Outputs) -> App@@ -96,15 +94,13 @@ next (Continue output)        = lift (readCfg output) >>= display next Previous                 = previous next (PreDefined name output) = predef name output-next Version                  = putStrLn "0.7.0"+next Version                  = putStrLn "0.7.1" next ConfigLocation           = configLocation next Help                     = putStrLn helpText-next (Error msg)              = failure msg-next (DryRun nxt)             = next nxt  go :: IO () go = do-    nxt <- parse . unwords <$> getArgs-    case nxt of-        (DryRun n) -> runReaderT (next n) True-        _          -> runReaderT (next nxt) False+    ready <- parse . unwords <$> getArgs+    case ready of+        Right (settings, nxt) -> runReaderT (next nxt) settings+        Left err              -> putStrLn err >> exitFailure
src/Cmt/IO/CLI.hs view
@@ -1,7 +1,13 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Cmt.IO.CLI where+module Cmt.IO.CLI+    ( blank+    , message+    , mehssage+    , header+    , errorMessage+    ) where  import ClassyPrelude @@ -9,29 +15,36 @@ import System.Console.ANSI (Color (Blue, Magenta, Red, Yellow), ColorIntensity (Dull),                             ConsoleLayer (Foreground), SGR (Reset, SetColor), hSetSGR) -blank :: IO ()+import Cmt.Types.App (App, settingsColourize)++setSGR :: Handle -> [SGR] -> App+setSGR hndl settings = do+    colourize <- asks settingsColourize+    when colourize $ lift (hSetSGR hndl settings)++blank :: App blank = putStrLn "" -message :: Text -> IO ()+message :: Text -> App message msg = do-    hSetSGR stdout [SetColor Foreground Dull Blue]-    hPutStrLn stdout msg-    hSetSGR stdout [Reset]+    setSGR stdout [SetColor Foreground Dull Blue]+    putStrLn msg+    setSGR stdout [Reset] -mehssage :: Text -> IO ()+mehssage :: Text -> App mehssage msg = do-    hSetSGR stdout [SetColor Foreground Dull Yellow]-    hPutStrLn stdout msg-    hSetSGR stdout [Reset]+    setSGR stdout [SetColor Foreground Dull Yellow]+    putStrLn msg+    setSGR stdout [Reset] -header :: Text -> IO ()+header :: Text -> App header msg = do-    hSetSGR stdout [SetColor Foreground Dull Magenta]-    hPutStrLn stdout $ "*** " ++ msg ++ " ***"-    hSetSGR stdout [Reset]+    setSGR stdout [SetColor Foreground Dull Magenta]+    putStrLn $ "*** " ++ msg ++ " ***"+    setSGR stdout [Reset] -errorMessage :: Text -> IO ()+errorMessage :: Text -> App errorMessage msg = do-    hSetSGR stderr [SetColor Foreground Dull Red]-    hPutStrLn stderr msg-    hSetSGR stderr [Reset]+    setSGR stderr [SetColor Foreground Dull Red]+    lift $ hPutStrLn stderr msg+    setSGR stderr [Reset]
src/Cmt/Parser/Arguments.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedLists #-}-{-# LANGUAGE TupleSections #-}  module Cmt.Parser.Arguments     ( parse@@ -11,6 +9,7 @@ import Data.Attoparsec.Text hiding (parse)  import Cmt.Parser.Attoparsec (ifP, lexeme, wordP)+import Cmt.Types.App         (Settings (Settings)) import Cmt.Types.Config      (Outputs) import Cmt.Types.Next        (Next (..)) @@ -41,21 +40,22 @@ helpP :: Parser Next helpP = string "-h" $> Help -dryRunP :: Parser Next -> Parser Next-dryRunP p = do+settingsP :: Parser Next -> Parser (Settings, Next)+settingsP p = do     dry <- ifP (string "--dry-run" *> skipSpace)+    colour <- not <$> ifP (string "--no-color" *> skipSpace)     next <- p-    pure $ bool next (DryRun next) dry+    let settings = Settings dry colour+    pure (settings, next) -argumentsP :: Parser Next+argumentsP :: Parser (Settings, Next) argumentsP =-    lexeme-        (helpP <|> versionP <|> configLocationP <|>-         dryRunP (previousP <|> preDefinedP <|> continueP))+    lexeme $+    settingsP (helpP <|> versionP <|> configLocationP <|> previousP <|> preDefinedP <|> continueP)  -- run parser-parse :: Text -> Next+parse :: Text -> Either Text (Settings, Next) parse arguments =     case parseOnly argumentsP arguments of-        Right c -> c-        Left _  -> Error "Could not parse arguments"+        Right c -> Right c+        Left _  -> Left "Could not parse arguments"
+ src/Cmt/Types/App.hs view
@@ -0,0 +1,19 @@+module Cmt.Types.App+    ( App+    , Settings(Settings)+    , defaultSettings+    , settingsDryRun+    , settingsColourize+    ) where++import ClassyPrelude++data Settings = Settings+    { settingsDryRun    :: Bool+    , settingsColourize :: Bool+    } deriving (Eq, Show)++type App = ReaderT Settings IO ()++defaultSettings :: Settings+defaultSettings = Settings {settingsDryRun = False, settingsColourize = True}
src/Cmt/Types/Next.hs view
@@ -16,6 +16,4 @@     | Version     | ConfigLocation     | Help-    | Error Text-    | DryRun Next     deriving (Eq, Show)
templates/usage.txt view
@@ -1,9 +1,13 @@-Usage: cmt [--dry-run] [message]+Usage: cmt [--dry-run] [--no-color] [options | message] +Settings:++--dry-run       Displays the commit message without committing+--no-color      Don't use bash colour codes in output+ Options:  -h              Display this help message -c              Display location of .cmt file -v              Display version number---dry-run       Displays the commit message without committing --prev          Runs previous attempt after failure/dry run
test/Cmt/Parser/ArgumentsTest.hs view
@@ -2,10 +2,13 @@  module Cmt.Parser.ArgumentsTest where +import ClassyPrelude+ import Test.Tasty import Test.Tasty.HUnit  import Cmt.Parser.Arguments (parse)+import Cmt.Types.App        (Settings (Settings), defaultSettings) import Cmt.Types.Next       (Next (..))  test_config :: TestTree@@ -14,12 +17,27 @@         "Cmt.Parser.Arguments"         [ testGroup               "single arguments"-              [ testCase "help" (assertEqual "Gives back Help" Help (parse "-h"))-              , testCase "version" (assertEqual "Gives back Version" Version (parse "-v"))+              [ testCase+                    "help"+                    (assertEqual "Gives back Help" (Right (defaultSettings, Help)) (parse "-h"))               , testCase+                    "version"+                    (assertEqual+                         "Gives back Version"+                         (Right (defaultSettings, Version))+                         (parse "-v"))+              , testCase                     "config location"-                    (assertEqual "Gives back ConfigLocation" ConfigLocation (parse "-c"))-              , testCase "previous" (assertEqual "Gives back Previous" Previous (parse "--prev"))+                    (assertEqual+                         "Gives back ConfigLocation"+                         (Right (defaultSettings, ConfigLocation))+                         (parse "-c"))+              , testCase+                    "previous"+                    (assertEqual+                         "Gives back Previous"+                         (Right (defaultSettings, Previous))+                         (parse "--prev"))               ]         , testGroup               "PreDefined"@@ -27,43 +45,55 @@                     "predefined message"                     (assertEqual                          "Gives back PreDefined and name"-                         (PreDefined "test" [])+                         (Right (defaultSettings, PreDefined "test" []))                          (parse "-p test"))               , testCase                     "predefined message plus message"                     (assertEqual                          "Gives back PreDefined, name and message"-                         (PreDefined "test" [("*", "a message")])+                         (Right (defaultSettings, PreDefined "test" [("*", "a message")]))                          (parse "-p test a message"))               ]         , testGroup               "Continue"               [ testCase                     "continue"-                    (assertEqual "Gives back empty Continue" (Continue []) (parse ""))+                    (assertEqual+                         "Gives back empty Continue"+                         (Right (defaultSettings, Continue []))+                         (parse ""))               , testCase                     "continue"                     (assertEqual                          "Gives back Continue with message"-                         (Continue [("*", "a message")])+                         (Right (defaultSettings, Continue [("*", "a message")]))                          (parse "a message"))               ]         , testGroup-              "Dry Run"+              "Settings"               [ testCase                     "previous dryn run"-                    (assertEqual "Gives back Previous" (DryRun Previous) (parse "--dry-run --prev"))+                    (assertEqual+                         "Gives back Previous"+                         (Right (Settings True True, Previous))+                         (parse "--dry-run --prev"))               , testCase                     "predefined message plus message"                     (assertEqual                          "Gives back PreDefined, name and message"-                         (DryRun (PreDefined "test" [("*", "a message")]))+                         (Right (Settings True True, PreDefined "test" [("*", "a message")]))                          (parse "--dry-run -p test a message"))               , testCase                     "continue"                     (assertEqual                          "Gives back Continue with message"-                         (DryRun (Continue [("*", "a message")]))+                         (Right (Settings True True, Continue [("*", "a message")]))                          (parse "--dry-run a message"))+              , testCase+                    "predefined message plus message - no colours"+                    (assertEqual+                         "Gives back PreDefined, name and message"+                         (Right (Settings False False, PreDefined "test" [("*", "a message")]))+                         (parse "--no-color -p test a message"))               ]         ]