diff --git a/changes.txt b/changes.txt --- a/changes.txt +++ b/changes.txt @@ -1,3 +1,9 @@ +1.2.0.0 +------- + +- Released Fri 10 May 2019 23:23:25 CEST +- switched to megaparsec, lentil is now 35% faster! + 1.1.2.0 ------- diff --git a/issues.txt b/issues.txt --- a/issues.txt +++ b/issues.txt @@ -1,5 +1,5 @@ bin/sign.sh - 1 put this in Setup.hs? + 1 put this in Setup.hs? [refactor] doc/dev/issues.txt 11 check --output pretty, there are trailing white spaces [bug] [u:1] @@ -9,6 +9,9 @@ src/Lentil/File.hs 77 combine funziona su windows? [test] + +src/Lentil/Parse/Run.hs + 132 Row should be carried on by issues, not be manually set! [refactor] src/Lentil/Parse/Syntaxes.hs 25 qptain_nemo fake multiline comments in C (i.e. // and \ at the diff --git a/lentil.cabal b/lentil.cabal --- a/lentil.cabal +++ b/lentil.cabal @@ -1,5 +1,5 @@ name: lentil -version: 1.1.2.0 +version: 1.2.0.0 synopsis: frugal issue tracker description: minumum effort, cohesive issue tracker based on ubiquitous @TODO@s and @FIXME@s conventions. @@ -56,23 +56,24 @@ manual: True default: False + executable lentil main-is: Main.hs build-depends: base >= 4.9 && < 5.0, + ansi-wl-pprint==0.6.*, + csv==0.1.*, directory >= 1.2 && < 1.4, - transformers >= 0.3 && < 0.6, - pipes >= 4.2 && < 4.4, + filemanip==0.3.*, + filepath==1.4.*, + megaparsec==7.0.*, + mtl == 2.2.*, + natural-sort==0.1.*, optparse-applicative >= 0.13 && < 0.15, + pipes >= 4.2 && < 4.4, regex-tdfa==1.2.*, - natural-sort==0.1.*, - parsec==3.1.*, - filepath==1.4.*, - filemanip==0.3.*, - ansi-wl-pprint==0.6.*, - csv==0.1.*, - terminal-progress-bar==0.4.*, + semigroups==0.18.*, text==1.2.*, - semigroups==0.18.* + terminal-progress-bar==0.4.* other-modules: Lentil.Types, Lentil.Args, Lentil.File, Lentil.Print, Lentil.Query, Lentil.Export, Lentil.Parse.Source, Lentil.Parse.Issue Lentil.Parse.Syntaxes, @@ -84,6 +85,7 @@ else GHC-Options: -Wall + test-suite test default-language: Haskell2010 if flag(developer) @@ -93,20 +95,20 @@ HS-Source-Dirs: test, src main-is: Tests.hs build-depends: base >= 4.9 && < 5.0, + ansi-wl-pprint==0.6.*, + csv==0.1.*, directory >= 1.2 && < 1.4, - transformers >= 0.3 && < 0.6, - pipes >= 4.2 && < 4.4, + filemanip==0.3.*, + filepath==1.4.*, + megaparsec==7.0.*, + mtl == 2.2.*, + natural-sort==0.1.*, optparse-applicative >= 0.13 && < 0.15, + pipes >= 4.2 && < 4.4, regex-tdfa==1.2.*, - natural-sort==0.1.*, - parsec==3.1.*, - filepath==1.4.*, - filemanip==0.3.*, - ansi-wl-pprint==0.6.*, - csv==0.1.*, - terminal-progress-bar==0.4.*, + semigroups==0.18.*, text==1.2.*, - semigroups==0.18.* + terminal-progress-bar==0.4.* -- same as above, plus hspec , hspec >= 2.3 && < 2.8 other-modules: Lentil.Types, Lentil.Args, Lentil.File, Lentil.Print, diff --git a/src/Lentil/Helpers.hs b/src/Lentil/Helpers.hs --- a/src/Lentil/Helpers.hs +++ b/src/Lentil/Helpers.hs @@ -11,11 +11,14 @@ import Lentil.Types -import qualified System.IO as I -import qualified Text.Parsec as P -import qualified Text.Parsec.String as PS +import qualified System.IO as I +import qualified Text.Megaparsec as P +import qualified Text.Megaparsec.Char as PC +import qualified Control.Monad.State as S +type StateParser i s a = P.ParsecT String i (S.State s) a + -- output errors (to stderr) perr :: String -> IO () perr cs = I.hPutStrLn I.stderr cs @@ -30,16 +33,21 @@ -- PARSING -- ------------- --- like many1 for manyTill -manyTill1 :: PS.Parser a -> PS.Parser b -> PS.Parser [a] -manyTill1 p ed = (:) <$> p <*> P.manyTill p ed - +type StateParserError i = P.ParseErrorBundle i String +runStateParser :: StateParser i s a -> s -> FilePath -> i -> + Either (StateParserError i) a +runStateParser p s fp i = + let + eps = P.runParserT p fp i + ep = fst $ S.runState eps s + in ep -- parse an extension alias "aa->bc" -> Just ("aa", "bc") aliasp :: String -> Maybe Alias -aliasp s = either (const Nothing) Just (P.parse p "" s) +aliasp s = either (const Nothing) Just (runStateParser p () "" s) where - p = manyTill1 P.anyChar (P.string aliasSign) >>= \a -> - P.many P.anyChar >>= \b -> + p :: StateParser String s (String, String) + p = P.someTill P.anySingle (PC.string aliasSign) >>= \a -> + P.many P.anySingle >>= \b -> return ('.':a, '.':b) diff --git a/src/Lentil/Parse/Issue.hs b/src/Lentil/Parse/Issue.hs --- a/src/Lentil/Parse/Issue.hs +++ b/src/Lentil/Parse/Issue.hs @@ -10,17 +10,21 @@ module Lentil.Parse.Issue where import Lentil.Types +import Lentil.Helpers -import Text.Parsec +import Text.Megaparsec +import Text.Megaparsec.Char -import qualified Data.Char as C +import qualified Data.Char as C +import qualified Data.Maybe as M +import qualified Control.Monad.State as S ----------- -- TYPES -- ----------- -type ParIssue a = Parsec String [FlagWord] a +type ParIssue a = StateParser String [FlagWord] a -- standard flagwords stdFlagwords :: [FlagWord] @@ -28,7 +32,7 @@ -- top-level constant to evaluate once flagWords :: ParIssue [FlagWord] -flagWords = fmap (stdFlagwords ++) getState +flagWords = fmap (stdFlagwords ++) (S.lift S.get) --------------- -- PRIMITIVE -- @@ -66,7 +70,7 @@ -- anything goes, apart from ' ' tagLabel :: ParIssue String -tagLabel = many1 (satisfy sf) "tag label" +tagLabel = some (satisfy sf) "tag label" where sf :: Char -> Bool sf c | c == closeDel = False | C.isSpace c = False @@ -82,11 +86,8 @@ ------------- -- optional ws + flagwords (case unsensitive) + optional ':' ++ optional1 ws --- incipit have to be bound at the beginning of line (won't pick up stuff --- in the middle of a sentence) incipit :: ParIssue FlagWord -incipit = char '\n' >> spaces >> - fwpar >>= \fw -> +incipit = fwpar >>= \fw -> optional (char ':') >> notFollowedBy nonSpace >> -- real todo, not todoodle return (normaliseFlagword fw) @@ -97,6 +98,10 @@ nonSpace = satisfy (not . C.isSpace) +-- issues (bar the first one) should only appear at beginning of line +incipitv :: ParIssue FlagWord +incipitv = char '\n' *> space *> incipit + "incipit stopper" ------------ -- ISSUES -- @@ -110,8 +115,8 @@ -- tags can be placed *before* description, too issue :: ParIssue Issue issue = (mkIssue <$> incipit - <*> fmap sourceName getPosition - <*> fmap sourceLine getPosition + <*> fmap sourceName getSourcePos + <*> fmap (unPos . sourceLine) getSourcePos <*> option [] (try tags) <*> freeText <*> option [] (try tags)) @@ -127,24 +132,36 @@ -- any text. Since tags/fields at the end of the issue are optional, we need -- a way to delimit this. Delimiters are: eof, tags/fields, blank line freeText :: ParIssue (Maybe Description) -freeText = fmap htmlify (manyTill anyChar end) >>= \t -> +freeText = fmap htmlify (manyTill anySingle end) >>= \t -> case t of [] -> return Nothing _ -> return $ Just t "free text" - where vp p = try . parsecMap (const ()) $ p - end = lookAhead $ choice [vp (spaces1 *> tag), - vp blankline, -- \n\n or \neof - vp incipit, -- another issue - vp eof] - spaces1 = space *> spaces + where vp p = try . fmap (const ()) $ p + end = lookAhead $ choice [vp (space1 *> tag), + vp blankline, -- \n\n or \neof + vp incipitv, -- another issue + vp (eof :: ParIssue ())] tags :: ParIssue [Tag] -tags = many1 (try $ spaces *> tag) "tags" +tags = some (try $ space *> tag) "tags" -- parses a number of issues from a given line-of-text +data IF = I Issue | FT issues :: ParIssue [Issue] -issues = many (try $ manyTill anyChar (lookAhead $ try incipit) *> issue) - "issues" +issues = space *> -- first issue can have preceding ws + (M.catMaybes <$> ifs) + "issues" + where + -- unissue text + -- remember to consume what you find before a will-formed incipit + t :: ParIssue () + t = try (manyTill anySingle (lookAhead $ try incipitv)) *> + char '\n' *> space + + ifs :: ParIssue [Maybe Issue] + ifs = many (Just <$> issue <|> + Nothing <$ t) + diff --git a/src/Lentil/Parse/Run.hs b/src/Lentil/Parse/Run.hs --- a/src/Lentil/Parse/Run.hs +++ b/src/Lentil/Parse/Run.hs @@ -17,17 +17,16 @@ import Lentil.Parse.Source import Lentil.Parse.Syntaxes -import Text.Parsec +import Text.Megaparsec import Pipes -import qualified System.Directory as D -import qualified Data.Functor.Identity as I -import qualified System.ProgressBar as PB -import qualified Control.Monad as CM -import qualified Data.Text as T -import qualified Data.Text.Lazy as TL -import qualified Data.Text.IO as TI -import qualified Control.Exception as E +import qualified Control.Monad as CM +import qualified System.Directory as D +import qualified Control.Exception as E +import qualified System.ProgressBar as PB +import qualified Data.Text as T +import qualified Data.Text.IO as TI +import qualified Data.Text.Lazy as TL ----------- @@ -108,7 +107,7 @@ comm2Issues :: [FlagWord] -> Pipe (FilePath, Comment) [Issue] IO () comm2Issues fws = await >>= \(fp, (r, i)) -> runParPipe (setRow r >> issues) - fp fws ('\n':i) >> + fp fws i >> comm2Issues fws -- needed or will pick just head issue @@ -118,20 +117,24 @@ -- generic parsing -- -runParPipe :: (Stream i I.Identity t) => Parsec i s o -> - FilePath -> s -> i -> - Pipe ip o IO () -runParPipe p fp s i = case runParser p s fp i of - Left l -> liftIO (perr $ fp ++ " : parse error " ++ - show l) - Right r -> yield r +runParPipe :: (Show i, Show (Token i)) => + StateParser i s o -> + FilePath -> s -> i -> + Pipe ip o IO () +runParPipe p fp s i = + case runStateParser p s fp i of + Left l -> liftIO (perr $ fp ++ " : parse error " ++ + show l) + Right r -> yield r -- issue parsing -- --- why (r-1)? Every TODO must start on a newline, so we have to add a top --- '\n' in case there immediately is one +-- todo [refactor] Row should be carried on by issues, not be manually set! setRow :: Row -> ParIssue () -setRow r = getPosition >>= setPosition . flip setSourceLine (r-1) +setRow r = updateParserState + (\(State i o (PosState pix po (SourcePos n _ cx) tw lp)) -> + let l' = mkPos $ r in + (State i o (PosState pix po (SourcePos n l' cx) tw lp))) safeRead :: FilePath -> IO String safeRead fp = E.try (TI.readFile fp) >>= \case diff --git a/src/Lentil/Parse/Source.hs b/src/Lentil/Parse/Source.hs --- a/src/Lentil/Parse/Source.hs +++ b/src/Lentil/Parse/Source.hs @@ -13,11 +13,12 @@ import Lentil.Types import Lentil.Helpers -import Text.Parsec hiding (Line) +import Text.Megaparsec +import Text.Megaparsec.Char -import qualified Data.Char as C -import qualified Data.Maybe as M -import qualified Data.List as L +import qualified Data.Char as C +import qualified Data.Maybe as M +import qualified Data.List as L ----------- @@ -25,7 +26,7 @@ ----------- -- from source to comment strings -type ParSource a = Parsec String () a +type ParSource a = StateParser String () a data ParSyntax = -- 'standard' language (with single line and/or multiline -- markers, etc. @@ -45,6 +46,7 @@ data CharStyle = CommonChr | ErlangChr deriving (Show, Eq) + -------------- -- COMMENTS -- -------------- @@ -57,22 +59,22 @@ lineComment :: String -> ParSource CommentString lineComment s = SingleLine <$> (initId s *> getRow) <*> - manyTill anyChar newline + manyTill anySingle eol "line comment" where -- for 1-char line comments (#, ;, etc.), erases repeating initId :: String -> ParSource () - initId [a] = () <$ many1 (char a) + initId [a] = () <$ some (char a) initId as = () <$ string as blockComment :: (String, String) -> ParSource CommentString blockComment (i, e) = MultiLine <$> (string i *> getRow) <*> - manyTill anyChar (try $ string e) + manyTill anySingle (try $ string e) "block comment" getRow :: ParSource Row -getRow = fmap sourceLine getPosition +getRow = fmap (unPos . sourceLine) getSourcePos ------------- @@ -87,14 +89,14 @@ -- quoted strings, escaped by \, by mauke^ cString :: Char -> ParSource String -cString ic = q *> many ((char '\\' *> anyChar) <|> noneOf no) <* q +cString ic = q *> many ((char '\\' *> anySingle) <|> noneOf no) <* q "codestring" where q = char ic no = C.showLitChar ic "\\" -- sqllike string (no escape with \, '' to escape ') sqlString :: Char -> ParSource String -sqlString ic = char ic *> manyTill anyChar (char ic) +sqlString ic = char ic *> manyTill anySingle (char ic) -- we treat 'cdscsad cdscdsa '' csdcs' as two strings -- because the content is meaningless to our program @@ -109,13 +111,13 @@ -- quoted single character commonChar :: Char -> ParSource Char -commonChar ic = q *> ((char '\\' *> anyChar) <|> anyChar) <* q +commonChar ic = q *> ((char '\\' *> anySingle) <|> anySingle) <* q "char string sign" where q = char ic -- $a for 'a' (where ic = '$') erlangChar :: Char -> ParSource Char -erlangChar ic = char ic *> anyChar +erlangChar ic = char ic *> anySingle ------------------ @@ -126,7 +128,7 @@ -- a well formed element from above (linecomm, blockcom, stringlit, -- charLit) program :: ParSyntax -> ParSource String -program ps = manyTill1 anyChar (endp <|> ("" <$ eof)) +program ps = someTill anySingle (endp <|> ("" <$ eof)) "program" where -- endp :: [ParSource String] @@ -158,10 +160,11 @@ "rst todo directive" where startPara :: ParSource () - startPara = newline *> (() <$ satisfy (not . C.isSpace) <|> eof) + startPara = eol *> (() <$ satisfy (not . C.isSpace) <|> eof) todoBody :: ParSource String - todoBody = manyTill1 anyChar (lookAhead . try $ startPara <|> eof) + todoBody = someTill anySingle + (lookAhead . try $ startPara <|> eof) -- modText does 2 things -- 1. injects a dummy todo keyword, having discarded `.. todo::` @@ -177,18 +180,19 @@ -- everything else rstOther :: ParSource String -rstOther = manyTill1 anyChar (endp <|> eof) +rstOther = someTill anySingle (endp <|> eof) "rst other text" where endp = lookAhead . try $ rstTodoIncipit rstTodoIncipit :: ParSource () -rstTodoIncipit = fmap sourceColumn getPosition >>= \c -> +rstTodoIncipit = fmap (unPos . sourceColumn) getSourcePos >>= \c -> if c == 1 then () <$ string ".. todo::" else parserFail "rst todo incipit: not at begin-of-line" "rst todo incipit" - + where + parserFail s = customFailure s --------------------- -- ORG-MODE SYNTAX -- @@ -212,16 +216,16 @@ where body :: ParSource String body = (++) <$> pure " TODO " <*> - manyTill anyChar + manyTill anySingle -- A list item over multiple lines terminates either: -- + when an empty lines follows the last -- line of the current item, -- + or when a new list item follows. In -- this case, we must not consume the -- header of the list item. - ( try (newline *> newline) <|> - try (newline <* lookAhead (listMarker *> spaces)) <|> - ('x' <$ eof) + ( try (eol *> eol) <|> + try (eol <* lookAhead (listMarker *> space)) <|> + ("x" <$ eof) ) orgListSingle :: ParSource CommentString @@ -231,12 +235,12 @@ "org-mode list item in a single-line" where body :: ParSource String - body = (++) <$> pure " TODO " <*> manyTill anyChar newline + body = (++) <$> pure " TODO " <*> manyTill anySingle eol -- - [ ] or + [ ] or 1. or 1) orgInitList :: ParSource () -orgInitList = listMarker *> spaces *> - checkBox *> spaces +orgInitList = listMarker *> space *> + checkBox *> space where checkBox :: ParSource () checkBox = () <$ string "[ ]" @@ -248,16 +252,16 @@ numMark] where numMark :: ParSource Char - numMark = digit *> (char '.' <|> char ')') + numMark = digitChar *> (char '.' <|> char ')') orgOther :: ParSource () orgOther = choice - [() <$ newline, -- an empty line - () <$ manyTill1 anyChar (endp <|> eof)] -- a non-empty one + [() <$ eol, -- an empty line + () <$ someTill anySingle (endp <|> eof)] -- a non-empty one "org-mode other text" where - endp = () <$ newline + endp = () <$ eol ------------ @@ -283,7 +287,7 @@ -- ps: syntax to sever comment from the rest source :: ParSyntax -> ParSource [CommentString] -source ps = fmap M.catMaybes (many1 (sourcePart ps)) <|> ([] <$ eof) +source ps = fmap M.catMaybes (some (sourcePart ps)) <|> ([] <$ eof) "source file" diff --git a/src/Lentil/Parse/Syntaxes.hs b/src/Lentil/Parse/Syntaxes.hs --- a/src/Lentil/Parse/Syntaxes.hs +++ b/src/Lentil/Parse/Syntaxes.hs @@ -13,7 +13,7 @@ import Lentil.Parse.Source import Lentil.Types -import Text.Parsec +import Text.Megaparsec import Control.Applicative hiding (many) import Prelude @@ -101,7 +101,7 @@ -- paragraphs. How to implement this without breaking other -- parsers? org = source OrgModeSyntax -text = (:[]) . MultiLine 1 <$> many anyChar +text = (:[]) . MultiLine 1 <$> many anySingle -- ANCILLARIES -- diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -32,7 +32,7 @@ short 'v' S.<> help "show version and copyright info" ) where - versionCopy = "\nlentil - frugal issue tracker, version 1.1.2.0\n\ + versionCopy = "\nlentil - frugal issue tracker, version 1.2.0.0\n\ \(C) 2015-2019 Francesco Ariis - http://www.ariis.it\n\ \released under the GNU General Public License v3\n" diff --git a/test/Lentil/HelpersSpec.hs b/test/Lentil/HelpersSpec.hs --- a/test/Lentil/HelpersSpec.hs +++ b/test/Lentil/HelpersSpec.hs @@ -2,8 +2,8 @@ import Test.Hspec -import Text.Parsec -import Text.Parsec.String +import Text.Megaparsec +import Text.Megaparsec.Char import Lentil.Helpers @@ -12,9 +12,9 @@ -- Parsing tests -- simple parser (choosable if we are at begin of line or else) -sp :: Parser a -> String -> Maybe a +sp :: StateParser String () a -> String -> Maybe a sp p cs = either (const Nothing) Just - (runParser p () fp cs) + (runStateParser p () fp cs) where fp = "" @@ -25,17 +25,17 @@ spec :: Spec spec = do - describe "manyTill1" $ do + describe "someTill (megaparsec reexport)" $ do it "behaves like manyTill on non-empty string" $ - sp (manyTill1 anyChar newline) "foo\n" `shouldBe` - sp (manyTill anyChar newline) "foo\n" + sp (someTill anySingle newline) "foo\n" `shouldBe` + sp (manyTill anySingle newline) "foo\n" it "fails on empty string (while manyTill does not)" $ - (sp (manyTill1 anyChar newline) "\n", - sp (manyTill anyChar newline) "\n") `shouldBe` (Nothing, + (sp (someTill anySingle newline) "\n", + sp (manyTill anySingle newline) "\n") `shouldBe` (Nothing, Just "") it "has the same behaviour as manyTill on 1 char w/o end char" $ - sp (manyTill1 anyChar newline) "f" `shouldBe` - sp (manyTill anyChar newline) "f" + sp (someTill anySingle newline) "f" `shouldBe` + sp (manyTill anySingle newline) "f" describe "aliasp" $ do it "parses an extension alias" $ diff --git a/test/Lentil/Parse/IssueSpec.hs b/test/Lentil/Parse/IssueSpec.hs --- a/test/Lentil/Parse/IssueSpec.hs +++ b/test/Lentil/Parse/IssueSpec.hs @@ -1,12 +1,12 @@ module Lentil.Parse.IssueSpec where import Test.Hspec -import Text.Parsec ( runParser ) -import Text.Parsec.Char +import Text.Megaparsec.Char import Control.Applicative import Lentil.Types import Lentil.Parse.Issue +import Lentil.Helpers import Prelude -- 7.8 hack @@ -15,8 +15,9 @@ -- simple parser (choosable if we are at begin of line or else) sp :: [FlagWord] -> ParIssue a -> String -> Maybe a sp fws p cs = either (const Nothing) Just - (runParser p fws fp cs) - where fp = "" + (runStateParser p fws fp cs) + where + fp = "" main :: IO () @@ -65,24 +66,24 @@ describe "incipit" $ do it "parses the initial section of an issue, returns nothing" $ - do sp [] incipit "\n TODO: " `shouldBe` Just "todo" - sp [] incipit "\n FIXME: " `shouldBe` Just "fixme" - sp [] incipit "\nXXX: " `shouldBe` Just "xxx" + do sp [] incipit "TODO: " `shouldBe` Just "todo" + sp [] incipit "FIXME: " `shouldBe` Just "fixme" + sp [] incipit "XXX: " `shouldBe` Just "xxx" it "parses the initial section of an issue (user-defined flagword)" $ - sp ["feature"] incipit "\n Feature: " `shouldBe` Just "feature" + sp ["feature"] incipit "Feature: " `shouldBe` Just "feature" it "parses the initial sect. (user-defined, normalising)" $ - sp ["feaTure"] incipit "\n Feature: " `shouldBe` Just "feature" + sp ["feaTure"] incipit "Feature: " `shouldBe` Just "feature" it "doesn't work without previous newline" $ - sp [] incipit "\nTODO:some" `shouldBe` Nothing + sp [] incipit "TODO:some" `shouldBe` Nothing it "doesn't work with longer matches (todoodle)" $ - sp [] incipit "\nTODOodle:some" `shouldBe` Nothing + sp [] incipit "TODOodle:some" `shouldBe` Nothing it "doesn't work if you don't add a space after :" $ - do sp [] incipit "\nTODO:some" `shouldBe` Nothing - sp [] incipit "\nTODO_some" `shouldBe` Nothing + do sp [] incipit "TODO:some" `shouldBe` Nothing + sp [] incipit "TODO_some" `shouldBe` Nothing it "does allow you to omit the :" $ - sp [] incipit "\nxxx some" `shouldBe` Just "xxx" + sp [] incipit "xxx some" `shouldBe` Just "xxx" it "is case unsensitive in flag-word" $ - sp [] incipit "\ntOdO some" `shouldBe` Just "todo" + sp [] incipit "tOdO some" `shouldBe` Just "todo" it "doesn't allow anything before flag-words" $ sp [] incipit "so fixme someday" `shouldBe` Nothing it "fails if we are not at the beginning of line" $ @@ -118,52 +119,60 @@ describe "issue" $ do it "parses an issue" $ - sp [] issue "\n fixMe this is it [t] [f:w]" - `shouldBe` (Just $ Issue "" 2 (Just "this is it") + sp [] issue "fixMe this is it [t] [f:w]" + `shouldBe` (Just $ Issue "" 1 (Just "this is it") [Tag "fixme", Tag "t", Tag "f:w"]) it "parses tagless/fieldless issues too" $ - sp [] issue "\nTODO: this is it\n" - `shouldBe` (Just $ Issue "" 2 (Just "this is it") []) + sp [] issue "TODO: this is it\n" + `shouldBe` (Just $ Issue "" 1 (Just "this is it") []) it "parses an issue not ended by \\n" $ - sp [] issue "\ntodo block1 " - `shouldBe` (Just $ Issue "" 2 (Just "block1") []) + sp [] issue "todo block1 " + `shouldBe` (Just $ Issue "" 1 (Just "block1") []) it "doesn't display the eventual \\n at eof" $ - sp [] issue "\nTOdO: this is it\n" - `shouldBe` (Just $ Issue "" 2 (Just "this is it") []) + sp [] issue "TOdO: this is it\n" + `shouldBe` (Just $ Issue "" 1 (Just "this is it") []) it "does accept a lone (naked) todo" $ - sp [] issue "\ntodo\n" - `shouldBe` (Just $ Issue "" 2 Nothing []) + sp [] issue "todo\n" + `shouldBe` (Just $ Issue "" 1 Nothing []) it "issues declared with fixme get a free [fixme] tag" $ - sp [] issue "\nfixme blah\n" - `shouldBe` (Just $ Issue "" 2 (Just "blah") [Tag "fixme"]) + sp [] issue "fixme blah\n" + `shouldBe` (Just $ Issue "" 1 (Just "blah") [Tag "fixme"]) it "doesn't parse tags non separated by a space" $ - sp [] issue "\ntodo blah[f]\n" - `shouldBe` (Just $ Issue "" 2 (Just "blah[f]") []) + sp [] issue "todo blah[f]\n" + `shouldBe` (Just $ Issue "" 1 (Just "blah[f]") []) it "does parse an empty todo" $ - sp [] issue "\ntodo\n" - `shouldBe` (Just $ Issue "" 2 Nothing []) + sp [] issue "todo\n" + `shouldBe` (Just $ Issue "" 1 Nothing []) it "does parse an empty fixme" $ - sp [] issue "\nfixme \n" - `shouldBe` (Just $ Issue "" 2 Nothing [Tag "fixme"]) + sp [] issue "fixme \n" + `shouldBe` (Just $ Issue "" 1 Nothing [Tag "fixme"]) it "does parse an empty todo + tags" $ - sp [] issue "\ntodo [alfa]\n" - `shouldBe` (Just $ Issue "" 2 Nothing [Tag "alfa"]) + sp [] issue "todo [alfa]\n" + `shouldBe` (Just $ Issue "" 1 Nothing [Tag "alfa"]) it "does parse tags before description" $ - sp [] issue "\ntodo [alfa] beta\n" - `shouldBe` (Just $ Issue "" 2 (Just "beta") [Tag "alfa"]) + sp [] issue "todo [alfa] beta\n" + `shouldBe` (Just $ Issue "" 1 (Just "beta") [Tag "alfa"]) describe "issues" $ do it "parses multiple issues" $ + sp [] issues "TODO: this is it [f:w]\n TODO: hey [t]" + `shouldBe` Just [Issue "" 1 (Just "this is it") [Tag "f:w"], + Issue "" 2 (Just "hey") [Tag "t"]] + it "parses multiple issues, first starting w/ newline" $ sp [] issues "\nTODO: this is it [f:w]\n TODO: hey [t]" `shouldBe` Just [Issue "" 2 (Just "this is it") [Tag "f:w"], Issue "" 3 (Just "hey") [Tag "t"]] - it "doesn't parse multiple issues if on the same line" $ - sp [] issues "\nTODO: this is it [f:w] TODO: hey [t]" - `shouldBe` Just [Issue "" 2 (Just "this is it") [Tag "f:w"]] + it "parses multiple issues, first whitespaced" $ + sp [] issues " TODO: this is it [f:w]\n TODO: hey [t]" + `shouldBe` Just [Issue "" 1 (Just "this is it") [Tag "f:w"], + Issue "" 2 (Just "hey") [Tag "t"]] + it "does not parse multiple issues if on the same line" $ + sp [] issues "TODO: this is it [f:w] TODO: hey [t]" + `shouldBe` Just [Issue "" 1 (Just "this is it") [Tag "f:w"]] it "parses two issues, tagless, if the second starts on nl" $ - sp [] issues "\nTODO: this is it \n todo hey [t]" - `shouldBe` Just [Issue "" 2 (Just "this is it") [], - Issue "" 3 (Just "hey") [Tag "t"]] + sp [] issues "TODO: this is it \n todo hey [t]" + `shouldBe` Just [Issue "" 1 (Just "this is it") [], + Issue "" 2 (Just "hey") [Tag "t"]] it "doesn't pick issues in the middle of a sentence" $ sp [] issues "\nthis is not a todo as you can see" `shouldBe` Just [] diff --git a/test/Lentil/Parse/SourceSpec.hs b/test/Lentil/Parse/SourceSpec.hs --- a/test/Lentil/Parse/SourceSpec.hs +++ b/test/Lentil/Parse/SourceSpec.hs @@ -1,8 +1,9 @@ module Lentil.Parse.SourceSpec where import Test.Hspec -import Text.Parsec (runParser, many, anyChar) +import Text.Megaparsec (many, anySingle) +import Lentil.Helpers import Lentil.Types import Lentil.Parse.Source @@ -13,7 +14,7 @@ -- simple parser sp :: ParSource a -> String -> Maybe a sp p cs = either (const Nothing) Just - (runParser p () fp cs) + (runStateParser p () fp cs) where fp = "" -- short comment constructors @@ -97,7 +98,7 @@ sp rstDocumentPart ".. todo:: prova\n\n foo" `shouldBe` Just (Just $ ml 1 "TODO prova\n \n foo") it "parses a reStructuredText+sphinx document part: non-todo" $ - sp (rstDocumentPart *> many anyChar) + sp (rstDocumentPart *> many anySingle) "gianni \n.. todo:: prova\n\n foo" `shouldBe` Just ".. todo:: prova\n\n foo"