cmt 0.6.0.0 → 0.7.0.0

raw patch · 15 files changed

+343/−65 lines, 15 filesdep +ansi-terminalPVP ok

version bump matches the API change (PVP)

Dependencies added: ansi-terminal

API changes (from Hackage documentation)

Files

• README.md +19/−2
• cmt.cabal +9/−1
• src/Cmt.hs +70/−43
• src/Cmt/IO/CLI.hs +37/−0
• src/Cmt/IO/Config.hs +19/−9
• src/Cmt/IO/Git.hs +6/−5
• src/Cmt/Parser/Arguments.hs +61/−0
• src/Cmt/Parser/Attoparsec.hs +8/−2
• src/Cmt/Parser/Config/Parts.hs +1/−1
• src/Cmt/Parser/Config/PreDefined.hs +2/−1
• src/Cmt/Types/Next.hs +21/−0
• src/Cmt/Utility.hs +11/−0
• templates/usage.txt +9/−0
• test/Cmt/Parser/ArgumentsTest.hs +69/−0
• test/Spec.hs +1/−1

@@ -182,12 +182,29 @@ cmt "blah blah blah" # this will go in ${*} place ``` -### Re-run Failed Commits+### Dry Runs -If the commit returns with a non-zero status code, your previous commit message is stored in a `.cmt.bkp` file. You can re-run the commit when you're ready with:+If you add `--dry-run` as the first argument, `cmt` will show you the output, but not try and make a commit. It will store the output so you can easily run it without having to re-enter everything.  ```bash+cmt --dry-run "Blah blah blah"+cmt --dry-run -p vb+```++### Re-run Failed/Dry Run Commits++If the commit returns with a non-zero status code or you run with `--dry-run`, your previous commit message is stored in a `.cmt.bkp` file. You can re-run the commit when you're ready with:++```bash cmt --prev+```++### Other Options++```bash+cmt -h # displays usage information+cmt -v # displays version number+cmt -c # displays location of .cmt file ```  

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: cmt-version: 0.6.0.0+version: 0.7.0.0 license: BSD3 license-file: LICENSE copyright: Small Hadron Collider / Mark Wales@@ -15,6 +15,7 @@ build-type: Simple extra-source-files:     README.md+    templates/usage.txt  source-repository head     type: git@@ -23,10 +24,12 @@ library     exposed-modules:         Cmt+        Cmt.IO.CLI         Cmt.IO.Config         Cmt.IO.Git         Cmt.IO.Input         Cmt.Output.Format+        Cmt.Parser.Arguments         Cmt.Parser.Attoparsec         Cmt.Parser.Config         Cmt.Parser.Config.Format@@ -34,17 +37,21 @@         Cmt.Parser.Config.PreDefined         Cmt.Parser.Options         Cmt.Types.Config+        Cmt.Types.Next+        Cmt.Utility     hs-source-dirs: src     other-modules:         Paths_cmt     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude     build-depends:+        ansi-terminal >=0.9.1 && <0.10,         attoparsec >=0.13.2.3 && <0.14,         base >=4.7 && <5,         classy-prelude >=1.5.0 && <1.6,         containers >=0.6.0.1 && <0.7,         directory >=1.3.3.0 && <1.4,+        file-embed >=0.0.11.1 && <0.1,         filepath >=1.4.2.1 && <1.5,         process >=1.6.5.0 && <1.7,         terminal-size >=0.3.2.1 && <0.4,@@ -68,6 +75,7 @@     main-is: Spec.hs     hs-source-dirs: test     other-modules:+        Cmt.Parser.ArgumentsTest         Cmt.Parser.ConfigTest         Cmt.Parser.OptionsTest         Paths_cmt

@@ -1,4 +1,5 @@ {-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} @@ -8,54 +9,75 @@  import ClassyPrelude +import Data.FileEmbed   (embedFile) import Data.Text        (stripEnd)-import System.Directory (removeFile)+import System.Directory (doesFileExist, removeFile) import System.Exit      (ExitCode (..), exitFailure, exitSuccess) -import Cmt.IO.Config     (checkFormat, load, readCfg)-import Cmt.IO.Git        (commit)-import Cmt.IO.Input      (loop)-import Cmt.Output.Format (format)-import Cmt.Parser.Config (predefined)-import Cmt.Types.Config  (Config, Outputs)+import Cmt.IO.CLI           (blank, errorMessage, header, mehssage, message)+import Cmt.IO.Config        (checkFormat, findFile, load, readCfg)+import Cmt.IO.Git           (commit)+import Cmt.IO.Input         (loop)+import Cmt.Output.Format    (format)+import Cmt.Parser.Arguments (parse)+import Cmt.Parser.Config    (predefined)+import Cmt.Types.Config     (Config, Outputs)+import Cmt.Types.Next       (Next (..)) -data Next-    = Previous-    | PreDefined Text-                 Outputs-    | Continue Outputs-    | Version+type App = ReaderT Bool IO () +helpText :: Text+helpText = decodeUtf8 $(embedFile "templates/usage.txt")+ backup :: FilePath backup = ".cmt.bkp" -failure :: Text -> IO ()-failure msg = putStrLn msg >> exitFailure+failure :: Text -> App+failure msg = lift (errorMessage msg >> exitFailure) -send :: Text -> IO ()-send txt = do-    commited <- commit $ stripEnd txt+dryRun :: Text -> App+dryRun txt =+    lift $ do+        header "Result"+        blank+        message txt+        blank+        writeFile backup (encodeUtf8 txt)+        mehssage "run: cmt --prev to commit"+        exitSuccess++commitRun :: Text -> App+commitRun txt = do+    commited <- lift (commit $ stripEnd txt)     case commited of-        ExitSuccess -> exitSuccess+        ExitSuccess -> lift exitSuccess         ExitFailure _ -> do             writeFile backup (encodeUtf8 txt)-            exitFailure+            lift exitFailure -display :: Either Text (Config, Outputs) -> IO ()+send :: Text -> App+send txt = do+    dry <- ask+    bool commitRun dryRun dry txt++display :: Either Text (Config, Outputs) -> App display (Left err) = putStrLn err display (Right (cfg, output)) = do-    parts <- loop cfg+    parts <- lift $ loop cfg     send $ format cfg (output ++ parts) -previous :: IO ()+previous :: App previous = do-    txt <- decodeUtf8 <$> readFile backup-    removeFile backup-    send txt+    exists <- lift $ doesFileExist backup+    if exists+        then (do txt <- decodeUtf8 <$> readFile backup+                 lift $ removeFile backup+                 send txt)+        else (failure "No previous commit attempts") -predef :: Text -> Outputs -> IO ()+predef :: Text -> Outputs -> App predef name output = do-    cfg <- load+    cfg <- lift load     case predefined =<< cfg of         Left msg -> failure msg         Right pre ->@@ -63,21 +85,26 @@                 Nothing -> failure "No matching predefined message"                 Just cf -> display $ checkFormat output cf -parseArgs :: [Text] -> Next-parseArgs ["-v"]            = Version-parseArgs ["--prev"]        = Previous-parseArgs ["-p", name]      = PreDefined name []-parseArgs ["-p", name, msg] = PreDefined name [("*", msg)]-parseArgs ("-p":name:parts) = PreDefined name [("*", unwords parts)]-parseArgs []                = Continue []-parseArgs [msg]             = Continue [("*", msg)]-parseArgs parts             = Continue [("*", unwords parts)]+configLocation :: App+configLocation = do+    file <- lift findFile+    case file of+        Just path -> putStrLn (pack path)+        Nothing   -> failure ".cmt file not found" +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 ConfigLocation           = configLocation+next Help                     = putStrLn helpText+next (Error msg)              = failure msg+next (DryRun nxt)             = next nxt+ go :: IO () go = do-    next <- parseArgs <$> getArgs-    case next of-        Continue output        -> readCfg output >>= display-        Previous               -> previous-        PreDefined name output -> predef name output-        Version                -> putStrLn "0.6.0"+    nxt <- parse . unwords <$> getArgs+    case nxt of+        (DryRun n) -> runReaderT (next n) True+        _          -> runReaderT (next nxt) False

@@ -0,0 +1,37 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.IO.CLI 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 ()+blank = putStrLn ""++message :: Text -> IO ()+message msg = do+    hSetSGR stdout [SetColor Foreground Dull Blue]+    hPutStrLn stdout msg+    hSetSGR stdout [Reset]++mehssage :: Text -> IO ()+mehssage msg = do+    hSetSGR stdout [SetColor Foreground Dull Yellow]+    hPutStrLn stdout msg+    hSetSGR stdout [Reset]++header :: Text -> IO ()+header msg = do+    hSetSGR stdout [SetColor Foreground Dull Magenta]+    hPutStrLn stdout $ "*** " ++ msg ++ " ***"+    hSetSGR stdout [Reset]++errorMessage :: Text -> IO ()+errorMessage msg = do+    hSetSGR stderr [SetColor Foreground Dull Red]+    hPutStrLn stderr msg+    hSetSGR stderr [Reset]

@@ -4,6 +4,7 @@  module Cmt.IO.Config     ( load+    , findFile     , readCfg     , checkFormat     ) where@@ -16,6 +17,7 @@  import Cmt.Parser.Config (config) import Cmt.Types.Config+import Cmt.Utility       ((<?>))  configFile :: FilePath configFile = ".cmt"@@ -52,22 +54,30 @@         then pure $ Just fp         else checkParent path -homeDir :: IO (Maybe FilePath)-homeDir = do-    home <- getHomeDirectory-    let fp = home </> configFile+xdgCfg :: IO (Maybe FilePath)+xdgCfg = do+    fp <- (</> ".config" </> "cmt" </> configFile) <$> getHomeDirectory     exists <- doesFileExist fp-    pure $-        if exists-            then Just fp-            else Nothing+    pure $ bool Nothing (Just fp) exists +homeCfg :: IO (Maybe FilePath)+homeCfg = do+    fp <- (</> configFile) <$> getHomeDirectory+    exists <- doesFileExist fp+    pure $ bool Nothing (Just fp) exists++globalCfg :: IO (Maybe FilePath)+globalCfg = do+    xdg <- xdgCfg+    home <- homeCfg+    pure $ xdg <?> home+ findFile :: IO (Maybe FilePath) findFile = do     inDir <- checkDir =<< getCurrentDirectory     case inDir of         Just fp -> pure $ Just fp-        Nothing -> homeDir+        Nothing -> globalCfg  load :: IO (Either Text Text) load = do

@@ -12,12 +12,13 @@ import System.Process (readCreateProcessWithExitCode, shell, spawnCommand, waitForProcess)  -- copied from https://hackage.haskell.org/package/posix-escape+escapeChar :: Char -> String+escapeChar '\0' = ""+escapeChar '\'' = "'\"'\"'"+escapeChar x    = [x]+ escape :: String -> String-escape xs = "'" ++ concatMap f xs ++ "'"-  where-    f '\0' = ""-    f '\'' = "'\"'\"'"-    f x    = [x]+escape xs = "'" ++ concatMap escapeChar xs ++ "'"  commit :: Text -> IO ExitCode commit message = do

@@ -0,0 +1,61 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE TupleSections #-}++module Cmt.Parser.Arguments+    ( parse+    ) where++import ClassyPrelude++import Data.Attoparsec.Text hiding (parse)++import Cmt.Parser.Attoparsec (ifP, lexeme, wordP)+import Cmt.Types.Config      (Outputs)+import Cmt.Types.Next        (Next (..))++outputsP :: Parser Outputs+outputsP =+    lexeme $ do+        message <- takeText+        pure [("*", message)]++emptyOutputsP :: Parser Outputs+emptyOutputsP = endOfInput $> []++continueP :: Parser Next+continueP = Continue <$> (emptyOutputsP <|> outputsP)++preDefinedP :: Parser Next+preDefinedP = PreDefined <$> (string "-p" *> skipSpace *> wordP) <*> (emptyOutputsP <|> outputsP)++previousP :: Parser Next+previousP = string "--prev" $> Previous++configLocationP :: Parser Next+configLocationP = string "-c" $> ConfigLocation++versionP :: Parser Next+versionP = string "-v" $> Version++helpP :: Parser Next+helpP = string "-h" $> Help++dryRunP :: Parser Next -> Parser Next+dryRunP p = do+    dry <- ifP (string "--dry-run" *> skipSpace)+    next <- p+    pure $ bool next (DryRun next) dry++argumentsP :: Parser Next+argumentsP =+    lexeme+        (helpP <|> versionP <|> configLocationP <|>+         dryRunP (previousP <|> preDefinedP <|> continueP))++-- run parser+parse :: Text -> Next+parse arguments =+    case parseOnly argumentsP arguments of+        Right c -> c+        Left _  -> Error "Could not parse arguments"

@@ -26,8 +26,14 @@ stripComments :: Parser a -> Parser a stripComments p = lexeme $ commentP *> p <* commentP -word :: Parser Text-word = pack <$> many1 (letter <|> space)+wordP :: Parser Text+wordP = pack <$> many1 (letter <|> digit) +wordsP :: Parser Text+wordsP = pack <$> many1 (letter <|> space)+ valid :: [Name] -> Parser Text valid names = choice $ "*" : (string <$> names)++ifP :: Parser () -> Parser Bool+ifP p = option False (p $> True)

@@ -30,7 +30,7 @@  -- name nameP :: Parser Text-nameP = char '"' *> word <* char '"' <* lexeme (char '=')+nameP = char '"' *> wordsP <* char '"' <* lexeme (char '=')  -- part partP :: Parser Part

@@ -5,8 +5,9 @@     ( predefinedPartsP     ) where -import ClassyPrelude+import ClassyPrelude hiding (fail) +import Control.Monad.Fail   (fail) import Data.Attoparsec.Text  import Cmt.Parser.Attoparsec

@@ -0,0 +1,21 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Cmt.Types.Next+    ( Next(..)+    ) where++import ClassyPrelude++import Cmt.Types.Config (Outputs)++data Next+    = Previous+    | PreDefined Text+                 Outputs+    | Continue Outputs+    | Version+    | ConfigLocation+    | Help+    | Error Text+    | DryRun Next+    deriving (Eq, Show)

@@ -0,0 +1,11 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedLists #-}++module Cmt.Utility where++import ClassyPrelude++(<?>) :: Maybe a -> Maybe a -> Maybe a+(<?>) Nothing b = b+(<?>) a _       = a

@@ -0,0 +1,9 @@+Usage: cmt [--dry-run] [message]++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

@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedLists #-}++module Cmt.Parser.ArgumentsTest where++import Test.Tasty+import Test.Tasty.HUnit++import Cmt.Parser.Arguments (parse)+import Cmt.Types.Next       (Next (..))++test_config :: TestTree+test_config =+    testGroup+        "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+                    "config location"+                    (assertEqual "Gives back ConfigLocation" ConfigLocation (parse "-c"))+              , testCase "previous" (assertEqual "Gives back Previous" Previous (parse "--prev"))+              ]+        , testGroup+              "PreDefined"+              [ testCase+                    "predefined message"+                    (assertEqual+                         "Gives back PreDefined and name"+                         (PreDefined "test" [])+                         (parse "-p test"))+              , testCase+                    "predefined message plus message"+                    (assertEqual+                         "Gives back PreDefined, name and message"+                         (PreDefined "test" [("*", "a message")])+                         (parse "-p test a message"))+              ]+        , testGroup+              "Continue"+              [ testCase+                    "continue"+                    (assertEqual "Gives back empty Continue" (Continue []) (parse ""))+              , testCase+                    "continue"+                    (assertEqual+                         "Gives back Continue with message"+                         (Continue [("*", "a message")])+                         (parse "a message"))+              ]+        , testGroup+              "Dry Run"+              [ testCase+                    "previous dryn run"+                    (assertEqual "Gives back Previous" (DryRun Previous) (parse "--dry-run --prev"))+              , testCase+                    "predefined message plus message"+                    (assertEqual+                         "Gives back PreDefined, name and message"+                         (DryRun (PreDefined "test" [("*", "a message")]))+                         (parse "--dry-run -p test a message"))+              , testCase+                    "continue"+                    (assertEqual+                         "Gives back Continue with message"+                         (DryRun (Continue [("*", "a message")]))+                         (parse "--dry-run a message"))+              ]+        ]

@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF tasty-discover #-}+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --hide-successes #-}