diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/cmt.cabal b/cmt.cabal --- a/cmt.cabal +++ b/cmt.cabal @@ -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 diff --git a/src/Cmt.hs b/src/Cmt.hs --- a/src/Cmt.hs +++ b/src/Cmt.hs @@ -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 diff --git a/src/Cmt/IO/Config.hs b/src/Cmt/IO/Config.hs --- a/src/Cmt/IO/Config.hs +++ b/src/Cmt/IO/Config.hs @@ -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" diff --git a/src/Cmt/IO/Git.hs b/src/Cmt/IO/Git.hs --- a/src/Cmt/IO/Git.hs +++ b/src/Cmt/IO/Git.hs @@ -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 diff --git a/src/Cmt/IO/Input.hs b/src/Cmt/IO/Input.hs --- a/src/Cmt/IO/Input.hs +++ b/src/Cmt/IO/Input.hs @@ -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 diff --git a/src/Cmt/Parser/Attoparsec.hs b/src/Cmt/Parser/Attoparsec.hs new file mode 100644 --- /dev/null +++ b/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 diff --git a/src/Cmt/Parser/Config.hs b/src/Cmt/Parser/Config.hs --- a/src/Cmt/Parser/Config.hs +++ b/src/Cmt/Parser/Config.hs @@ -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 '}') diff --git a/src/Cmt/Parser/Options.hs b/src/Cmt/Parser/Options.hs new file mode 100644 --- /dev/null +++ b/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 diff --git a/src/Cmt/Types/Config.hs b/src/Cmt/Types/Config.hs --- a/src/Cmt/Types/Config.hs +++ b/src/Cmt/Types/Config.hs @@ -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 diff --git a/test/Cmt/Parser/ConfigTest.hs b/test/Cmt/Parser/ConfigTest.hs --- a/test/Cmt/Parser/ConfigTest.hs +++ b/test/Cmt/Parser/ConfigTest.hs @@ -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" ] diff --git a/test/Cmt/Parser/OptionsTest.hs b/test/Cmt/Parser/OptionsTest.hs new file mode 100644 --- /dev/null +++ b/test/Cmt/Parser/OptionsTest.hs @@ -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, , ")) + ]