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 +5/−0
- cmt.cabal +2/−1
- src/Cmt.hs +16/−20
- src/Cmt/IO/CLI.hs +31/−18
- src/Cmt/Parser/Arguments.hs +12/−12
- src/Cmt/Types/App.hs +19/−0
- src/Cmt/Types/Next.hs +0/−2
- templates/usage.txt +6/−2
- test/Cmt/Parser/ArgumentsTest.hs +42/−12
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")) ] ]