Merge branch 'release/0.7.1'

README.md

@@ -199,6 +199,11 @@ If the commit returns with a non-zero status code or you run with `--dry-run`, y
 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

package.yaml

@@ -1,5 +1,5 @@
 name:                cmt
-version:             0.7.0.0
+version:             0.7.1.0
 github:              "smallhadroncollider/cmt"
 license:             BSD3
 author:              "Small Hadron Collider / Mark Wales"

roadmap.md

@@ -53,3 +53,4 @@
 - XDG Base Directory support for `.cmt` file
 - `--dry-run` option
 - Should throw an error if `.cmt.bkp` missing and using `--prev`
+- `--no-color option`

src/Cmt.hs

@@ -21,30 +21,28 @@ import Cmt.IO.Input         (loop)
 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")
 
 backup :: FilePath
 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 @@ commitRun txt = do
 
 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 :: Next -> App
 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

@@ -1,37 +1,50 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Cmt.IO.CLI where
+module Cmt.IO.CLI
+    ( blank
+    , message
+    , mehssage
+    , header
+    , errorMessage
+    ) where
 
 import ClassyPrelude
 
 import Data.Text.IO        (hPutStrLn)
 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

@@ -1,6 +1,4 @@
-{-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedLists #-}
-{-# LANGUAGE TupleSections #-}
 
 module Cmt.Parser.Arguments
     ( parse
@@ -11,6 +9,7 @@ import ClassyPrelude
 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 @@ versionP = string "-v" $> Version
 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

@@ -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

@@ -16,6 +16,4 @@ data Next
     | Version
     | ConfigLocation
     | Help
-    | Error Text
-    | DryRun Next
     deriving (Eq, Show)

templates/usage.txt

@@ -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

@@ -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,56 +17,83 @@ test_config =
         "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"
               [ testCase
                     "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"))
               ]
         ]