Merge branch 'release/0.7.0'

.gitignore

@@ -1,4 +1,6 @@
 .stack-work/
+.stack-build/
+dist-newstyle/
 cmt.cabal
 .cmt.bkp
 *~

README.md

@@ -182,14 +182,31 @@ If you're using the `${*}` format option then:
 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
+```
+
 
 ## Install
 

package.yaml

@@ -1,5 +1,5 @@
 name:                cmt
-version:             0.6.0.0
+version:             0.7.0.0
 github:              "smallhadroncollider/cmt"
 license:             BSD3
 author:              "Small Hadron Collider / Mark Wales"
@@ -8,6 +8,7 @@ copyright:           "Small Hadron Collider / Mark Wales"
 
 extra-source-files:
 - README.md
+- templates/usage.txt
 
 synopsis:            Write consistent git commit messages
 category:            Command Line Tools
@@ -24,10 +25,12 @@ dependencies:
 library:
   source-dirs: src
   dependencies:
+  - ansi-terminal
   - attoparsec
   - containers
   - text
   - directory
+  - file-embed
   - filepath
   - process
   - terminal-size

roadmap.md

@@ -1,21 +1,24 @@
 ## Bugs
 
 - Multi-line is always optional
+- Multi-line always shows two entry inputs, even if first is empty
 - Should throw an error if no staged changes?
+- Remove `.cmt.bkp` on success `--prev`
 
 ## Features
 
-- List option?
-    > Automatically adds a hyphen to each entry?
-- Make parts optional
-    > @? and !@? operators?
 - Character limits
 - Line length limits
-- Descriptions alongside part name
+- Make parts optional
+    > @? and !@? operators?
+- List option?
+    > Automatically adds a hyphen to each entry?
 - Repeated sections
     > e.g. Co-Author: ${Name} ${Email}
 - Optional output bits
     > e.g. (${Scope}) shouldn't show brackets if no Scope provided
+- Descriptions alongside part name
+- Free-text option in option lists
 
 ## Doing
 
@@ -46,3 +49,7 @@
 - Should strip empty space/newlines from end of file
 - Way to store pre-written commits
     > Occasionally used messages: e.g. "version bump", "latest notes", etc.
+- Should pipe input out as it's happening
+- XDG Base Directory support for `.cmt` file
+- `--dry-run` option
+- Should throw an error if `.cmt.bkp` missing and using `--prev`

src/Cmt.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLists #-}
 
@@ -8,76 +9,102 @@ module Cmt
 
 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 ->
             case lookup name pre of
                 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

src/Cmt/IO/CLI.hs

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

src/Cmt/IO/Config.hs

@@ -4,6 +4,7 @@
 
 module Cmt.IO.Config
     ( load
+    , findFile
     , readCfg
     , checkFormat
     ) where
@@ -16,6 +17,7 @@ import System.FilePath  (takeDirectory, (</>))
 
 import Cmt.Parser.Config (config)
 import Cmt.Types.Config
+import Cmt.Utility       ((<?>))
 
 configFile :: FilePath
 configFile = ".cmt"
@@ -52,22 +54,30 @@ checkDir path = do
         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

src/Cmt/IO/Git.hs

@@ -12,12 +12,13 @@ import System.Exit    (ExitCode)
 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