cmt 0.2.0.0 → 0.3.0.0

raw patch · 12 files changed

+233/−64 lines, 12 filesdep +terminal-sizePVP ok

version bump matches the API change (PVP)

Dependencies added: terminal-size

API changes (from Hackage documentation)

Files

• README.md +11/−4
• cmt.cabal +5/−1
• src/Cmt.hs +36/−3
• src/Cmt/IO/Config.hs +7/−12
• src/Cmt/IO/Git.hs +23/−3
• src/Cmt/IO/Input.hs +55/−22
• src/Cmt/Parser/Attoparsec.hs +12/−0
• src/Cmt/Parser/Config.hs +19/−6
• src/Cmt/Parser/Options.hs +24/−0
• src/Cmt/Types/Config.hs +2/−3
• test/Cmt/Parser/ConfigTest.hs +5/−10
• test/Cmt/Parser/OptionsTest.hs +34/−0

@@ -41,6 +41,12 @@ cmt "blah blah blah" # this will go in ${*} place ``` +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:++```bash+cmt --prev+```+ ### Format  A `.cmt` file consist of two parts: the input parts and the output format.@@ -60,9 +66,9 @@         "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" = !@ } @@ -83,6 +89,7 @@  - `@`: single line input - `!@`: multi line input+- `%`: select from a list of staged files - `["option 1", "option 2"]`: list of options  #### Output Format@@ -97,7 +104,7 @@ # Input parts # * input not needed, as comes from command-line {-    "Scope" = @+    "Scope" = % }  # Scope from input and * from command-line

@@ -1,6 +1,6 @@ cabal-version: 1.12 name: cmt-version: 0.2.0.0+version: 0.3.0.0 license: BSD3 license-file: LICENSE copyright: Small Hadron Collider / Mark Wales@@ -27,7 +27,9 @@         Cmt.IO.Git         Cmt.IO.Input         Cmt.Output.Format+        Cmt.Parser.Attoparsec         Cmt.Parser.Config+        Cmt.Parser.Options         Cmt.Types.Config     hs-source-dirs: src     other-modules:@@ -41,6 +43,7 @@         directory >=1.3.3.0 && <1.4,         filepath >=1.4.2.1 && <1.5,         process >=1.6.3.0 && <1.7,+        terminal-size >=0.3.2.1 && <0.4,         text >=1.2.3.1 && <1.3  executable cmt@@ -62,6 +65,7 @@     hs-source-dirs: test     other-modules:         Cmt.Parser.ConfigTest+        Cmt.Parser.OptionsTest         Paths_cmt     default-language: Haskell2010     default-extensions: OverloadedStrings NoImplicitPrelude

@@ -7,18 +7,51 @@  import ClassyPrelude +import System.Directory (removeFile)+ 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) +data Next+    = Previous+    | Continue [Output]++backup :: FilePath+backup = ".cmt.bkp"++send :: Text -> IO ()+send txt = do+    commited <- commit txt+    case commited of+        Right msg -> putStrLn msg+        Left msg -> do+            writeFile backup (encodeUtf8 txt)+            putStrLn msg+ 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+    send $ format cfg (output ++ parts) +previous :: IO ()+previous = do+    txt <- decodeUtf8 <$> readFile backup+    removeFile backup+    send txt++parseArgs :: [Text] -> Next+parseArgs ["--prev"] = Previous+parseArgs []         = Continue []+parseArgs [msg]      = Continue [("*", msg)]+parseArgs parts      = Continue [("*", unwords parts)]+ go :: IO ()-go = load >>= display+go = do+    next <- parseArgs <$> getArgs+    case next of+        Continue output -> load output >>= display+        Previous        -> previous

@@ -1,7 +1,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} -module Cmt.IO.Config where+module Cmt.IO.Config+    ( load+    ) where  import ClassyPrelude @@ -32,11 +34,6 @@ 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@@ -69,11 +66,9 @@         Just fp -> pure $ Just fp         Nothing -> homeDir -load :: IO (Either Text (Config, [Output]))-load = do+load :: [Output] -> IO (Either Text (Config, [Output]))+load output = do     exists <- findFile     case exists of-        Just path -> do-            output <- parseArgs <$> getArgs-            parse output <$> read path-        Nothing -> pure $ Left ".cmt file not found"+        Just path -> parse output <$> read path+        Nothing   -> pure $ Left ".cmt file not found"

@@ -3,14 +3,34 @@  module Cmt.IO.Git     ( commit+    , changed     ) where  import ClassyPrelude +import System.Exit    (ExitCode (ExitFailure)) import System.Process (readCreateProcessWithExitCode, shell) -commit :: Text -> IO Text+-- copied from https://hackage.haskell.org/package/posix-escape+escape :: String -> String+escape xs = "'" ++ concatMap f xs ++ "'"+  where+    f '\0' = ""+    f '\'' = "'\"'\"'"+    f x    = [x]++commit :: Text -> IO (Either Text Text) commit message = do-    let msg = "git commit -m '" <> unpack message <> "'"+    let msg = "git commit -m" <> escape (unpack message)+    (code, out, err) <- readCreateProcessWithExitCode (shell msg) ""+    let output = unlines (pack <$> filter (not . null) [out, err])+    pure $+        case code of+            ExitFailure _ -> Left output+            _             -> Right output++changed :: IO [Text]+changed = do+    let msg = "git diff --name-only --cached"     (_, out, _) <- readCreateProcessWithExitCode (shell msg) ""-    pure $ pack out+    pure . lines $ pack out

@@ -7,37 +7,70 @@  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' -> do+            let picked = catMaybes $ choice opts' <$> chosen'+            if null picked+                then options opts+                else pure $ intercalate ", " picked+ 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

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

@@ -9,12 +9,10 @@  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 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 @@  -- 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 '}')

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

@@ -13,12 +13,11 @@     | 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 Config =     Config [Part]-           Format+           [FormatPart]     deriving (Show, Eq)  partName :: Part -> Name

@@ -18,8 +18,7 @@ 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         [ 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"         ]

@@ -0,0 +1,34 @@+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE OverloadedStrings #-}++module Cmt.Parser.OptionsTest where++import ClassyPrelude++import Test.Tasty+import Test.Tasty.HUnit++import Cmt.Parser.Options (parse)++-- import Test.Tasty.HUnit+test_config :: TestTree+test_config =+    testGroup+        "Cmt.Parser.Options"+        [ testCase+              "basic"+              (assertEqual "Gives back correct format" (Just [1, 2, 3]) (parse "1, 2, 3"))+        , testCase "no spaces" (assertEqual "Gives back correct format" (Just [1, 3]) (parse "1,3"))+        , testCase+              "missing number"+              (assertEqual "Gives back correct format" (Just [12, 3]) (parse "12, , 3"))+        , testCase+              "starting comma"+              (assertEqual "Gives back correct format" (Just [12, 3]) (parse ",12, 3"))+        , testCase+              "mess"+              (assertEqual+                   "Gives back correct format"+                   (Just [12, 4, 3])+                   (parse ",,  , 12,,4   ,  3,   , "))+        ]