cmt (empty) → 0.2.0.0

raw patch · 14 files changed

+604/−0 lines, 14 filesdep +attoparsecdep +basedep +classy-preludesetup-changed

Dependencies added: attoparsec, base, classy-prelude, cmt, directory, file-embed, filepath, process, tasty, tasty-discover, tasty-expected-failure, tasty-hunit, text

Files

• LICENSE +30/−0
• README.md +111/−0
• Setup.hs +2/−0
• app/Main.hs +10/−0
• cmt.cabal +77/−0
• src/Cmt.hs +24/−0
• src/Cmt/IO/Config.hs +79/−0
• src/Cmt/IO/Git.hs +16/−0
• src/Cmt/IO/Input.hs +43/−0
• src/Cmt/Output/Format.hs +20/−0
• src/Cmt/Parser/Config.hs +86/−0
• src/Cmt/Types/Config.hs +39/−0
• test/Cmt/Parser/ConfigTest.hs +66/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,30 @@+Copyright Small Hadron Collider / Mark Wales (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Small Hadron Collider / Mark Wales nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,111 @@+# cmt++Write consistent git commit messages++## 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.++```bash+cmt # will show the options and then commit+```++If you're using the `${*}` format option then:++```bash+cmt "blah blah blah" # this will go in ${*} place+```++### Format++A `.cmt` file consist of two parts: the input parts and the output format.++For example, the [AngularJS Commit Message Guidelines](https://gist.github.com/stephenparish/9941e89d80e2bc58a153):++```txt+# The input parts+{+    # Shows a list of options+    "Type" = [+        "feat",+        "fix",+        "docs",+        "style",+        "refactor",+        "test",+        "chore"+    ]+    "Scope" = @ # Allows a single line of input+    "Subject" = @+    "Body" = !@ # Allows multi-line input+    "Footer" = !@+}++# The output format+# Takes the values provided from the input stage+# and interpolates them in+${Type} (${Scope}): ${Subject}++${Body}++${Footer}+```+++#### Input Parts++These are at the top of the `.cmt` file and surrounded by opening and closing curly braces. A consist of a name and a type:++- `@`: single line input+- `!@`: multi line input+- `["option 1", "option 2"]`: list of options++#### Output Format++The output format consists of named input parts plus anything else you want.++You can accept a output called `${*}`, which will add in whatever is passed to `cmt` as command line arguments.++For example:++```txt+# Input parts+# * input not needed, as comes from command-line+{+    "Scope" = @+}++# Scope from input and * from command-line+(${Scope}): ${*}+```++Then use with:++```bash+cmt "Blah blah blah"+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,10 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Main where++import ClassyPrelude++import Cmt (go)++main :: IO ()+main = go

@@ -0,0 +1,77 @@+cabal-version: 1.12+name: cmt+version: 0.2.0.0+license: BSD3+license-file: LICENSE+copyright: Small Hadron Collider / Mark Wales+maintainer: mark@smallhadroncollider.com+author: Small Hadron Collider / Mark Wales+homepage: https://github.com/smallhadroncollider/cmt#readme+bug-reports: https://github.com/smallhadroncollider/cmt/issues+synopsis: Write consistent git commit messages+description:+    Please see the README on GitHub at <https://github.com/smallhadroncollider/cmt#readme>+category: Command Line Tools+build-type: Simple+extra-source-files:+    README.md++source-repository head+    type: git+    location: https://github.com/smallhadroncollider/cmt++library+    exposed-modules:+        Cmt+        Cmt.IO.Config+        Cmt.IO.Git+        Cmt.IO.Input+        Cmt.Output.Format+        Cmt.Parser.Config+        Cmt.Types.Config+    hs-source-dirs: src+    other-modules:+        Paths_cmt+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    build-depends:+        attoparsec >=0.13.2.2 && <0.14,+        base >=4.7 && <5,+        classy-prelude >=1.5.0 && <1.6,+        directory >=1.3.3.0 && <1.4,+        filepath >=1.4.2.1 && <1.5,+        process >=1.6.3.0 && <1.7,+        text >=1.2.3.1 && <1.3++executable cmt+    main-is: Main.hs+    hs-source-dirs: app+    other-modules:+        Paths_cmt+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4.7 && <5,+        classy-prelude >=1.5.0 && <1.6,+        cmt -any++test-suite cmt-test+    type: exitcode-stdio-1.0+    main-is: Spec.hs+    hs-source-dirs: test+    other-modules:+        Cmt.Parser.ConfigTest+        Paths_cmt+    default-language: Haskell2010+    default-extensions: OverloadedStrings NoImplicitPrelude+    ghc-options: -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4.7 && <5,+        classy-prelude >=1.5.0 && <1.6,+        cmt -any,+        file-embed >=0.0.11 && <0.1,+        tasty ==1.2.*,+        tasty-discover >=4.2.1 && <4.3,+        tasty-expected-failure >=0.11.1.1 && <0.12,+        tasty-hunit >=0.10.0.1 && <0.11

@@ -0,0 +1,24 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt+    ( go+    ) where++import ClassyPrelude++import Cmt.IO.Config     (load)+import Cmt.IO.Git        (commit)+import Cmt.IO.Input      (loop)+import Cmt.Output.Format (format)+import Cmt.Types.Config  (Config, Output)++display :: Either Text (Config, [Output]) -> IO ()+display (Left err) = putStrLn err+display (Right (cfg, output)) = do+    parts <- loop cfg+    let txt = format cfg (output ++ parts)+    commit txt >>= putStrLn++go :: IO ()+go = load >>= display

@@ -0,0 +1,79 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.IO.Config where++import ClassyPrelude++import Data.List        (nub)+import System.Directory (doesFileExist, getCurrentDirectory, getHomeDirectory)+import System.FilePath  (takeDirectory, (</>))++import Cmt.Parser.Config (config)+import Cmt.Types.Config++configFile :: FilePath+configFile = ".cmt"++checkFormat :: [Output] -> Config -> Either Text (Config, [Output])+checkFormat output (Config parts format) = do+    let partNames = nub $ partName <$> parts+    let formatNames = nub . catMaybes $ formatName <$> format+    let result+            | isJust (find (== "*") formatNames) && null output = Left "Command line entry missing"+            | (length partNames + length output) /= length formatNames =+                Left "Parts and format do not match"+            | otherwise = Right (Config parts format, output)+    result++parse :: [Output] -> Text -> Either Text (Config, [Output])+parse output cfg = config cfg >>= checkFormat output++read :: FilePath -> IO Text+read path = decodeUtf8 <$> readFile path++parseArgs :: [Text] -> [Output]+parseArgs []    = []+parseArgs [msg] = [("*", msg)]+parseArgs parts = [("*", unwords parts)]++checkParent :: FilePath -> IO (Maybe FilePath)+checkParent path = do+    let parent = takeDirectory path+    if parent /= path+        then checkDir parent+        else pure Nothing++checkDir :: FilePath -> IO (Maybe FilePath)+checkDir path = do+    let fp = path </> configFile+    exists <- doesFileExist fp+    if exists+        then pure $ Just fp+        else checkParent path++homeDir :: IO (Maybe FilePath)+homeDir = do+    home <- getHomeDirectory+    let fp = home </> configFile+    exists <- doesFileExist fp+    pure $+        if exists+            then Just fp+            else Nothing++findFile :: IO (Maybe FilePath)+findFile = do+    inDir <- checkDir =<< getCurrentDirectory+    case inDir of+        Just fp -> pure $ Just fp+        Nothing -> homeDir++load :: IO (Either Text (Config, [Output]))+load = do+    exists <- findFile+    case exists of+        Just path -> do+            output <- parseArgs <$> getArgs+            parse output <$> read path+        Nothing -> pure $ Left ".cmt file not found"

@@ -0,0 +1,16 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.IO.Git+    ( commit+    ) where++import ClassyPrelude++import System.Process (readCreateProcessWithExitCode, shell)++commit :: Text -> IO Text+commit message = do+    let msg = "git commit -m '" <> unpack message <> "'"+    (_, out, _) <- readCreateProcessWithExitCode (shell msg) ""+    pure $ pack out

@@ -0,0 +1,43 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.IO.Input+    ( loop+    ) where++import ClassyPrelude++import Cmt.Types.Config++listItem :: (Int, Text) -> IO ()+listItem (n, o) = putStrLn $ tshow n <> ") " <> o++multiLine :: [Text] -> IO [Text]+multiLine input = do+    value <- getLine+    if null value+        then pure input+        else multiLine $ input ++ [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)++loop :: Config -> IO [(Name, Text)]+loop (Config parts _) = sequence $ output <$> parts

@@ -0,0 +1,20 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.Output.Format+    ( format+    ) where++import ClassyPrelude++import Cmt.Types.Config++tidy :: [Output] -> FormatPart -> Text+tidy _ (Literal c) = c+tidy parts (Named name) =+    case find ((== name) . fst) parts of+        Just (_, t) -> t+        Nothing     -> ""++format :: Config -> [Output] -> Text+format (Config _ fmt) parts = concat $ tidy parts <$> fmt

@@ -0,0 +1,86 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.Parser.Config+    ( config+    ) where++import ClassyPrelude++import Data.Attoparsec.Text++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++chopt :: Char -> Parser Text+chopt ch = option "" (tchar ch)++tnotChar :: Char -> Parser Text+tnotChar c = pack <$> many1 (notChar c)++commentP :: Parser ()+commentP = lexeme $ many' (char '#' *> many' (notChar '\n') *> char '\n') $> ()++stripComments :: Parser a -> Parser a+stripComments p = lexeme $ commentP *> p <* commentP++word :: Parser Text+word = pack <$> many1 (letter <|> space)++valid :: [Name] -> Parser Text+valid names = choice $ "*" : (string <$> names)++-- format parts+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)++-- input parts+lineP :: Parser PartType+lineP = char '@' $> Line++linesP :: Parser PartType+linesP = string "!@" $> Lines++listItemP :: Parser Text+listItemP = stripComments $ char '"' *> tnotChar '"' <* char '"' <* chopt ','++listP :: Parser PartType+listP = Options <$> (char '[' *> many' listItemP <* char ']')++-- name+nameP :: Parser Text+nameP = char '"' *> word <* char '"' <* lexeme (char '=')++-- part+partP :: Parser Part+partP = stripComments $ Part <$> nameP <*> (listP <|> lineP <|> linesP)++partsP :: Parser [Part]+partsP = stripComments $ stripComments (char '{') *> many' partP <* stripComments (char '}')++configP :: Parser Config+configP = do+    parts <- partsP+    format <- formatP $ partName <$> parts+    _ <- endOfInput+    pure $ Config parts format++-- run parser+config :: Text -> Either Text Config+config cfg =+    case parseOnly configP cfg of+        Right c -> Right c+        Left _ ->+            Left "Could not parse config. Check that your format doesn't contain any invalid parts."

@@ -0,0 +1,39 @@+{-# LANGUAGE NoImplicitPrelude #-}++module Cmt.Types.Config where++import ClassyPrelude (Eq, Maybe (..), Show, Text)++type Output = (Name, Text)++type Name = Text++data FormatPart+    = Named Name+    | Literal Text+    deriving (Show, Eq)++type Format = [FormatPart]++data PartType+    = Options [Text]+    | Line+    | Lines+    deriving (Show, Eq)++data Part =+    Part Name+         PartType+    deriving (Show, Eq)++data Config =+    Config [Part]+           Format+    deriving (Show, Eq)++partName :: Part -> Name+partName (Part name _) = name++formatName :: FormatPart -> Maybe Name+formatName (Named name) = Just name+formatName _            = Nothing

@@ -0,0 +1,66 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Cmt.Parser.ConfigTest where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Data.FileEmbed (embedFile)++import Cmt.Parser.Config (config)+import Cmt.Types.Config++basic :: Text+basic = decodeUtf8 $(embedFile "test/data/.cmt")++basicConfig :: Config+basicConfig =+    Config [Part "Week" Line] [Named "Week", Literal ":", Literal " ", Named "*", Literal "\n"]++angular :: Text+angular = decodeUtf8 $(embedFile "test/data/.cmt-angular")++comments :: Text+comments = decodeUtf8 $(embedFile "test/data/.cmt-comments")++angularConfig :: Config+angularConfig =+    Config+        [ Part "Type" (Options ["feat", "fix", "docs", "style", "refactor", "test", "chore"])+        , Part "Scope" Line+        , Part "Short Message" Line+        , Part "Body" Lines+        ]+        [ Named "Type"+        , Literal " "+        , Literal "("+        , Named "Scope"+        , Literal ")"+        , Literal ":"+        , Literal " "+        , Named "Short Message"+        , Literal "\n"+        , Literal "\n"+        , Named "Body"+        , Literal "\n"+        ]++-- import Test.Tasty.HUnit+test_config :: TestTree+test_config =+    testGroup+        "Cmt.Parser.Config"+        [ testCase+              "basic"+              (assertEqual "Gives back correct format" (Right basicConfig) (config basic))+        , testCase+              "angular"+              (assertEqual "Gives back correct format" (Right angularConfig) (config angular))+        , testCase+              "comments"+              (assertEqual "Gives back correct format" (Right angularConfig) (config comments))+        ]

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF tasty-discover #-}