Merge branch 'release/0.2.1'

.cmt

@@ -8,7 +8,7 @@
         "test",
         "chore"
     ]
-    "Scope" = @
+    "Scope" = %
     "Body" = !@
 }
 

README.md

@@ -2,12 +2,31 @@
 
 Write consistent git commit messages
 
-## Installation
+## Install
+
+[Binaries for Mac and Linux are available](https://github.com/smallhadroncollider/cmt/releases). Add the binary to a directory in your path (such as `/usr/local/bin`).
+
+### Cabal
+
+**Requirements**: [Cabal](https://www.haskell.org/cabal/)
+
+```bash
+cabal install cmt
+```
+
+Make sure you run `cabal update` if you haven't run it recently.
+
+### Building
+
+**Requirements**: [Stack](https://docs.haskellstack.org/en/stable/README/)
+
+The following command will build cmt and then install it in `~/.local/bin`:
 
 ```bash
 stack build && stack install
 ```
 
+
 ## Usage
 
 Add a `.cmt` file to your project directory.
@@ -41,9 +60,9 @@ For example, the [AngularJS Commit Message Guidelines](https://gist.github.com/s
         "test",
         "chore"
     ]
-    "Scope" = @ # Allows a single line of input
-    "Subject" = @
-    "Body" = !@ # Allows multi-line input
+    "Scope" = % # Select from a list of staged files
+    "Subject" = @ # Single line input
+    "Body" = !@ # Multi-line input
     "Footer" = !@
 }
 
@@ -64,6 +83,7 @@ These are at the top of the `.cmt` file and surrounded by opening and closing cu
 
 - `@`: single line input
 - `!@`: multi line input
+- `%`: select from a list of staged files
 - `["option 1", "option 2"]`: list of options
 
 #### Output Format
@@ -78,7 +98,7 @@ For example:
 # Input parts
 # * input not needed, as comes from command-line
 {
-    "Scope" = @
+    "Scope" = %
 }
 
 # Scope from input and * from command-line

package.yaml

@@ -1,5 +1,5 @@
 name:                cmt
-version:             0.2.0.0
+version:             0.2.1.0
 github:              "smallhadroncollider/cmt"
 license:             BSD3
 author:              "Small Hadron Collider / Mark Wales"
@@ -29,6 +29,7 @@ library:
   - directory
   - filepath
   - process
+  - terminal-size
 
 executables:
   cmt:

roadmap.md

@@ -1,20 +1,15 @@
 ## Bugs
 
-- pre-commit errors don't get displayed at all
-    > Probably need to show stderr in some cases?
-- Extra new-line at the end of the output
+- Multi-line is always optional
 
 ## Features
 
-- Show options in flat list if short?
 - Store previous commit info if it fails
     > Store if commit fails. `cmt --prev` option?
 - List option?
     > Automatically adds a hyphen to each entry?
 - Make parts optional
     > @? and !@? operators?
-- Option to show files that have changed
-    > Useful for things like ${Scope} - autocomplete maybe?
 
 ## Doing
 
@@ -33,3 +28,8 @@
 - Should search up directories to find .cmt
 - Should support ~/.cmt for global option
 - Add comments to .cmt
+- pre-commit errors don't get displayed at all
+    > Probably need to show stderr in some cases?
+- Show options in flat list if short?
+- Option to show files that have changed
+    > Useful for things like ${Scope} - autocomplete maybe? `git diff --name-only`

src/Cmt/IO/Git.hs

@@ -3,6 +3,7 @@
 
 module Cmt.IO.Git
     ( commit
+    , changed
     ) where
 
 import ClassyPrelude
@@ -12,5 +13,11 @@ import System.Process (readCreateProcessWithExitCode, shell)
 commit :: Text -> IO Text
 commit message = do
     let msg = "git commit -m '" <> unpack message <> "'"
+    (_, out, err) <- readCreateProcessWithExitCode (shell msg) ""
+    pure $ unlines (pack <$> filter (not . null) [out, err])
+
+changed :: IO [Text]
+changed = do
+    let msg = "git diff --name-only --cached"
     (_, out, _) <- readCreateProcessWithExitCode (shell msg) ""
-    pure $ pack out
+    pure . lines $ pack out

src/Cmt/IO/Input.hs

@@ -7,37 +7,66 @@ module Cmt.IO.Input
 
 import ClassyPrelude
 
+import System.Console.Terminal.Size (size, width)
+
+import Cmt.IO.Git         (changed)
+import Cmt.Parser.Options (parse)
 import Cmt.Types.Config
 
-listItem :: (Int, Text) -> IO ()
-listItem (n, o) = putStrLn $ tshow n <> ") " <> o
+prompt :: Text -> IO Text
+prompt s = do
+    putStr $ s <> " "
+    hFlush stdout
+    getLine
+
+getWidth :: IO Int
+getWidth = maybe 0 width <$> size
+
+putName :: Text -> IO ()
+putName name = putStrLn $ "\n" <> name <> ":"
+
+listItem :: (Int, Text) -> Text
+listItem (n, o) = tshow n <> ") " <> o
+
+displayOptions :: [(Int, Text)] -> IO ()
+displayOptions opts = do
+    let long = intercalate "   " $ listItem <$> opts
+    maxLength <- getWidth
+    if length long < maxLength
+        then putStrLn long
+        else sequence_ $ putStrLn . listItem <$> opts
+
+choice :: [(Int, Text)] -> Int -> Maybe Text
+choice opts chosen = snd <$> find ((== chosen) . fst) opts
+
+options :: [Text] -> IO Text
+options opts = do
+    let opts' = zip [1 ..] opts
+    displayOptions opts'
+    chosen <- parse <$> prompt ">"
+    case chosen of
+        Nothing      -> options opts
+        Just chosen' -> pure . intercalate ", " . catMaybes $ choice opts' <$> chosen'
 
 multiLine :: [Text] -> IO [Text]
 multiLine input = do
-    value <- getLine
-    if null value
+    value <- prompt ">"
+    if null value && not (null input)
         then pure input
         else multiLine $ input ++ [value]
 
+line :: IO Text
+line = do
+    value <- prompt ">"
+    if null value
+        then line
+        else pure value
+
 output :: Part -> IO (Name, Text)
-output (Part name Line) = do
-    putStrLn $ name <> ":"
-    val <- getLine
-    if null val
-        then output (Part name Line)
-        else pure (name, val)
-output (Part name (Options opts)) = do
-    let opts' = zip [1 ..] opts
-    putStrLn $ name <> ":"
-    sequence_ $ listItem <$> opts'
-    chosen <- getLine
-    case find ((== chosen) . tshow . fst) opts' of
-        Nothing     -> output (Part name (Options opts))
-        Just (_, o) -> pure (name, o)
-output (Part name Lines) = do
-    putStrLn $ name <> ":"
-    val <- unlines <$> multiLine []
-    pure (name, val)
+output (Part name Line)           = putName name >> (,) name <$> line
+output (Part name (Options opts)) = putName name >> (,) name <$> options opts
+output (Part name Lines)          = putName name >> (,) name <$> (unlines <$> multiLine [])
+output (Part name Changed)        = putName name >> (,) name <$> (options =<< changed)
 
 loop :: Config -> IO [(Name, Text)]
 loop (Config parts _) = sequence $ output <$> parts

src/Cmt/Parser/Attoparsec.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Cmt.Parser.Attoparsec
+    ( lexeme
+    ) where
+
+import ClassyPrelude
+
+import Data.Attoparsec.Text
+
+lexeme :: Parser a -> Parser a
+lexeme p = skipSpace *> p <* skipSpace

src/Cmt/Parser/Config.hs

@@ -9,12 +9,10 @@ import ClassyPrelude
 
 import Data.Attoparsec.Text
 
+import Cmt.Parser.Attoparsec
 import Cmt.Types.Config
 
 -- useful bits
-lexeme :: Parser a -> Parser a
-lexeme p = skipSpace *> p <* skipSpace
-
 tchar :: Char -> Parser Text
 tchar ch = singleton <$> char ch
 
@@ -37,16 +35,31 @@ valid :: [Name] -> Parser Text
 valid names = choice $ "*" : (string <$> names)
 
 -- format parts
+merge :: [FormatPart] -> FormatPart -> [FormatPart]
+merge ps (Literal str) = maybe [Literal str] merge' (fromNullable ps)
+  where
+    merge' ps' =
+        case last ps' of
+            Literal prev -> init ps' <> [Literal (prev <> str)]
+            _            -> ps <> [Literal str]
+merge ps p = ps <> [p]
+
+smoosh :: [FormatPart] -> [FormatPart]
+smoosh = foldl' merge []
+
 formatNamedP :: [Name] -> Parser FormatPart
 formatNamedP names = Named <$> (string "${" *> valid names <* char '}')
 
 formatLiteralP :: Parser FormatPart
 formatLiteralP = Literal <$> (singleton <$> anyChar)
 
-formatP :: [Name] -> Parser Format
-formatP names = stripComments $ many1 (formatNamedP names <|> formatLiteralP)
+formatP :: [Name] -> Parser [FormatPart]
+formatP names = smoosh <$> stripComments (many1 (formatNamedP names <|> formatLiteralP))
 
 -- input parts
+changedP :: Parser PartType
+changedP = char '%' $> Changed
+
 lineP :: Parser PartType
 lineP = char '@' $> Line
 
@@ -65,7 +78,7 @@ nameP = char '"' *> word <* char '"' <* lexeme (char '=')
 
 -- part
 partP :: Parser Part
-partP = stripComments $ Part <$> nameP <*> (listP <|> lineP <|> linesP)
+partP = stripComments $ Part <$> nameP <*> (listP <|> lineP <|> linesP <|> changedP)
 
 partsP :: Parser [Part]
 partsP = stripComments $ stripComments (char '{') *> many' partP <* stripComments (char '}')

src/Cmt/Parser/Options.hs

@@ -0,0 +1,24 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Cmt.Parser.Options
+    ( parse
+    ) where
+
+import ClassyPrelude
+
+import Data.Attoparsec.Text (Parser, char, decimal, many', many1, parseOnly)
+
+import Cmt.Parser.Attoparsec (lexeme)
+
+commaP :: Parser ()
+commaP = void $ many' (lexeme $ char ',')
+
+optionsP :: Parser [Int]
+optionsP = lexeme . many1 $ commaP *> decimal <* commaP
+
+-- run parser
+parse :: Text -> Maybe [Int]
+parse options =
+    case parseOnly optionsP options of
+        Right c -> Just c
+        Left _  -> Nothing

src/Cmt/Types/Config.hs

@@ -13,12 +13,11 @@ data FormatPart
     | Literal Text
     deriving (Show, Eq)
 
-type Format = [FormatPart]
-
 data PartType
     = Options [Text]
     | Line
     | Lines
+    | Changed
     deriving (Show, Eq)
 
 data Part =
@@ -28,7 +27,7 @@ data Part =
 
 data Config =
     Config [Part]
-           Format
+           [FormatPart]
     deriving (Show, Eq)
 
 partName :: Part -> Name

stack.yaml

@@ -1,3 +1,4 @@
 resolver: lts-13.8
+pvp-bounds: both
 packages:
 - .

test/Cmt/Parser/ConfigTest.hs

@@ -18,8 +18,7 @@ basic :: Text
 basic = decodeUtf8 $(embedFile "test/data/.cmt")
 
 basicConfig :: Config
-basicConfig =
-    Config [Part "Week" Line] [Named "Week", Literal ":", Literal " ", Named "*", Literal "\n"]
+basicConfig = Config [Part "Week" Line] [Named "Week", Literal ": ", Named "*", Literal "\n"]
 
 angular :: Text
 angular = decodeUtf8 $(embedFile "test/data/.cmt-angular")
@@ -31,20 +30,16 @@ angularConfig :: Config
 angularConfig =
     Config
         [ Part "Type" (Options ["feat", "fix", "docs", "style", "refactor", "test", "chore"])
-        , Part "Scope" Line
+        , Part "Scope" Changed
         , Part "Short Message" Line
         , Part "Body" Lines
         ]
         [ Named "Type"
-        , Literal " "
-        , Literal "("
+        , Literal " ("
         , Named "Scope"
-        , Literal ")"
-        , Literal ":"
-        , Literal " "
+        , Literal "): "
         , Named "Short Message"
-        , Literal "\n"
-        , Literal "\n"
+        , Literal "\n\n"
         , Named "Body"
         , Literal "\n"
         ]