diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/cmt.cabal b/cmt.cabal --- a/cmt.cabal +++ b/cmt.cabal @@ -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 diff --git a/src/Cmt.hs b/src/Cmt.hs --- a/src/Cmt.hs +++ b/src/Cmt.hs @@ -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 diff --git a/src/Cmt/IO/CLI.hs b/src/Cmt/IO/CLI.hs --- a/src/Cmt/IO/CLI.hs +++ b/src/Cmt/IO/CLI.hs @@ -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] diff --git a/src/Cmt/Parser/Arguments.hs b/src/Cmt/Parser/Arguments.hs --- a/src/Cmt/Parser/Arguments.hs +++ b/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 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" diff --git a/src/Cmt/Types/App.hs b/src/Cmt/Types/App.hs new file mode 100644 --- /dev/null +++ b/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} diff --git a/src/Cmt/Types/Next.hs b/src/Cmt/Types/Next.hs --- a/src/Cmt/Types/Next.hs +++ b/src/Cmt/Types/Next.hs @@ -16,6 +16,4 @@ | Version | ConfigLocation | Help - | Error Text - | DryRun Next deriving (Eq, Show) diff --git a/templates/usage.txt b/templates/usage.txt --- a/templates/usage.txt +++ b/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 diff --git a/test/Cmt/Parser/ArgumentsTest.hs b/test/Cmt/Parser/ArgumentsTest.hs --- a/test/Cmt/Parser/ArgumentsTest.hs +++ b/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,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")) ] ]