lentil 1.0.1.0 → 1.0.2.0
raw patch · 18 files changed
+265/−207 lines, 18 files
Files
- changes.txt +7/−0
- doc/usr/page.rst +18/−0
- issues.txt +10/−8
- lentil.cabal +4/−2
- src/Lentil/Args.hs +16/−8
- src/Lentil/File.hs +15/−11
- src/Lentil/Parse/Issue.hs +19/−35
- src/Lentil/Parse/Run.hs +41/−42
- src/Lentil/Types.hs +3/−0
- src/Main.hs +4/−4
- test/Lentil/ArgsSpec.hs +3/−2
- test/Lentil/FileSpec.hs +12/−12
- test/Lentil/Parse/IssueSpec.hs +57/−45
- test/Lentil/Parse/RunSpec.hs +35/−26
- test/test-files/lang-comm/xyz.xyz +0/−12
- test/test-files/specific/cont-custom.c +4/−0
- test/test-files/specific/custom-fwords.c +5/−0
- test/test-files/specific/xyz.xyz +12/−0
changes.txt view
@@ -1,3 +1,10 @@+1.0.2.0+-------++- Released Sat 03 Sep 2016 01:40:42 CEST+- User can now provide custom flagwords (with -w)+ (following a request by Michał Antkiewi).+ 1.0.1.0 -------
doc/usr/page.rst view
@@ -138,6 +138,24 @@ Since the semantic of ``FIXME`` and ``XXX`` is specific (in respect to the usual ``TODO``), they are automatically added as a tag. +You can specify custom flag-words too, by using the ``-w`` option, e.g.:++::++ lentil . -w hack++ // HACK this issue will be parsed++User provided flagwords will have a tag automaticaly added (like ``FIXME``+and ``XXX``).++.. raw:: html++ <p><br/></p>++Recognised files+----------------+ As now lentil parses: - haskell source files (``.hs``, ``.lhs``, ``.chs``, ``.hsc``, ``.cabal``)
issues.txt view
@@ -37,30 +37,32 @@ src/Lentil/Args.hs 26 disambiguation optparse-applicative [feature:intermediate] 27 help as lentil PATH [ PATH... ] [ OPTIONS ] [feature:intermediate]- 103 uncomment and implement sorting [feature:intermediate]+ 111 uncomment and implement sorting [feature:intermediate] src/Lentil/Export.hs 36 maybe use a dedicated library to format xml? [design] src/Lentil/File.hs- 40 not using canonised paths because it is extremely slow on big+ 41 not using canonised paths because it is extremely slow on big repositories (like darcs). Explore different possibilities (conduit, new Filepath, unix program). [u:2] [duct]- 51 apparently toListM is not idiomatic [refactor] [duct]- 65 use pipes-files when released [feature:intermediate]- 76 combine funziona su windows? [feature:intermediate]+ 57 apparently toListM is not idiomatic [refactor] [duct]+ 68 use pipes-files when released [feature:intermediate]+ 80 combine funziona su windows? [feature:intermediate] src/Lentil/Parse/Issue.hs 30 "feature" flagword could (in theory) clash with a free-text comment (if it is present in the middle of a sentence at the beginning of a line). Consider alternatives (as: making new words configurable in- .lentil dotfile [design] [u:2] [bug]+ .lentil dotfile. After checking the linux kernel, it definitely is.+ Erase it and possibly make it an option [design] [u:3] [bug]+ 112 applicative style possible? [u:1] [refactor] src/Lentil/Parse/Run.hs 58 a function String -> [Issue] 80 <qptain> personally i don't like when the leading character of the progress bar is different [feeback] [request]- 97 sicuramente c'è un modo più elegante e breve. Ah! quando mettono le+ 96 sicuramente c'è un modo più elegante e breve. Ah! quando mettono le tuples section! [refactor] [duct] src/Lentil/Parse/Syntaxes.hs@@ -73,7 +75,7 @@ 58 o ord? [fixme] test/Lentil/ArgsSpec.hs- 37 real parsing testing options [test]+ 38 real parsing testing options [test] test/Lentil/FileSpec.hs 38 excluding files fails on MS Windows! Check why! [u:3] [bug]
lentil.cabal view
@@ -1,5 +1,5 @@ name: lentil-version: 1.0.1.0+version: 1.0.2.0 synopsis: frugal issue tracker description: minumum effort, cohesive issue tracker based on ubiquitous @TODO@s and @FIXME@s conventions.@@ -14,7 +14,6 @@ build-type: Simple tested-with: GHC==8.0.1 extra-source-files: stack.yaml,- test/test-files/lang-comm/xyz.xyz, test/test-files/lang-comm/clang.c, test/test-files/lang-comm/haskell.hs, test/test-files/lang-comm/javascript.js,@@ -29,7 +28,10 @@ test/test-files/lang-comm/test.txt, test/test-files/lang-comm/text.txt, test/test-files/specific/contiguous.c,+ test/test-files/specific/cont-custom.c, test/test-files/specific/uppercase.C,+ test/test-files/specific/xyz.xyz,+ test/test-files/specific/custom-fwords.c, test/test-files/test-proj/base-case/fold-a/foo1.hs, test/test-files/test-proj/base-case/fold-b/foo2.hs, test/test-files/test-proj/base-case/fold-c/foo3.hs,
src/Lentil/Args.hs view
@@ -26,12 +26,13 @@ -- TODO: disambiguation optparse-applicative [feature:intermediate] -- TODO: help as lentil PATH [ PATH... ] [ OPTIONS ] [feature:intermediate] -data LOptions = LOptions { loInExcl :: ([FilePath], [FilePath]),- loFormat :: Format,- loFilters :: [LFilter],- loSort :: [LSort],- loAlias :: [Alias],- loOutFile :: Maybe FilePath }+data LOptions = LOptions { loInExcl :: ([FilePath], [FilePath]),+ loFormat :: Format,+ loFilters :: [LFilter],+ loSort :: [LSort],+ loAlias :: [Alias],+ loFlagwords :: [FlagWord],+ loOutFile :: Maybe FilePath } type LFilter = [Issue] -> [Issue] type ChType = [LFilter] -> [Issue] -> [Issue] -- AND or OR chain@@ -40,11 +41,12 @@ lOpts :: Parser LOptions lOpts = LOptions <$> inexcls <*> format <*> filters <*>- issort <*> aliases <*> outfile+ issort <*> aliases <*> flagwords <*> outfile where inexcls = (,) <$> includes <*> many exclude filters = many $ foldl1 (<|>) [tag, notag, path, nopath, desc, nodesc]- aliases = fmap M.catMaybes (many alias)+ aliases = fmap M.catMaybes (many alias)+ flagwords = many flagword -------------@@ -85,6 +87,12 @@ where parseAlias :: String -> ReadM (Maybe Alias) parseAlias s = return (aliasp s)+++flagword :: Parser FlagWord+flagword = strOption ( short 'w' <>+ metavar "FLAGWORD" <>+ help ("additional flagword (e.g.: -w Hack)") ) outfile :: Parser (Maybe FilePath)
src/Lentil/File.hs view
@@ -24,6 +24,7 @@ import qualified Data.List as L import qualified Pipes.Prelude as PP + --------------- -- INSTANCES -- ---------------@@ -41,21 +42,23 @@ -- repositories (like darcs). Explore different possibilities -- (conduit, new Filepath, unix program). [u:2] [duct] -findIssues :: [Alias] -> [FilePath] -> [FilePath] -> IO [Issue]-findIssues as fps xs =- (fmap concat $ PP.toListM- (prodFilePaths fps xs as >-> issLoop)) >>= \r ->+findIssues :: [Alias] -> [FlagWord] ->+ [FilePath] -> [FilePath] -> IO [Issue]+findIssues as fws fps xs =+ findFiles as fps xs >>= \fl ->+ (fmap concat $ PP.toListM $ finalPipe fl) >>= \r -> perrEph "\r" >> -- clean progress bar return r- where issLoop = issueFinder as >> issLoop+ where+ finalPipe fl = prod fl >-> issLoop fl++ prod fl = each (zip fl [1..])+ issLoop fl = issueFinder as fws (length fl) >> issLoop fl -- todo: [refactor] [duct] apparently toListM is not idiomatic --- Filepaths to be parsed, as a Producer-prodFilePaths :: [FilePath] -> [FilePath] ->- [Alias] -> Producer FilePathC IO ()-prodFilePaths fps xs as = liftIO (fmap concat (mapM fc fps)) >>= \is ->- let is' = zip3 is [1..] (repeat $ length is) in- each is'+-- actual find function for IO ()+findFiles :: [Alias] -> [FilePath] -> [FilePath] -> IO [FilePath]+findFiles as fps xs = fmap concat (mapM fc fps) where fc i = find recPred (findClause (xs' i) as) i -- search pattern @@ -63,6 +66,7 @@ xs' _ = xs -- TODO: use pipes-files when released [feature:intermediate]+ -- fp to exclude, clause (+ aliases, to include) findClause :: [FilePath] -> [Alias] -> FindClause Bool
src/Lentil/Parse/Issue.hs view
@@ -25,37 +25,19 @@ -- TYPES -- ----------- -type ParIssue a = Parsec String () a---- TODO: "feature" flagword could (in theory) clash with a free-text comment--- (if it is present in the middle of a sentence at the beginning--- of a line). Consider alternatives (as: making new words--- configurable in .lentil dotfile. After checking the linux--- kernel, it definitely is. Erase it and possibly make it--- an option [design] [u:3] [bug]---- issue flagword-data FlagWord = Todo | Fixme | Xxx deriving (Enum, Eq)-+type ParIssue a = Parsec String [FlagWord] a -instance Show FlagWord where- show Todo = "todo"- show Fixme = "fixme"- show Xxx = "xxx"- -- show Feature = "feature"+-- standard flagwords+stdFlagwords :: [FlagWord]+stdFlagwords = ["todo", "fixme", "xxx"] -- top-level constant to evaluate once-flagWords :: [String]-flagWords = map show (enumFrom Todo)--instance S.IsString FlagWord where- fromString s = case map C.toLower s of- "todo" -> Todo- "fixme" -> Fixme- "xxx" -> Xxx- -- "feature" -> Feature- e -> error ("unrecognised flag word: " ++ e)+flagWords :: ParIssue [FlagWord]+flagWords = fmap (stdFlagwords ++) getState +-- all to lower+normaliseFlagword :: FlagWord -> FlagWord+normaliseFlagword t = map C.toLower t --------------- -- PRIMITIVE --@@ -113,14 +95,16 @@ -- 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 ->- optional (char ':') >>- notFollowedBy alphaNum >> -- real todo, not todoodle- return fw+incipit = char '\n' >> spaces >>+ fwpar >>= \fw ->+ optional (char ':') >>+ notFollowedBy alphaNum >> -- real todo, not todoodle+ return (normaliseFlagword fw) <?> "incipit" where- fwpar = choice (map (try . ciString) flagWords) >>=+ -- todo [u:1] [refactor] applicative style possible?+ fwpar = flagWords >>= \fw ->+ choice (map (try . ciString) fw) >>= return . S.fromString @@ -145,8 +129,8 @@ where mkIssue fw fp ln tg1 ds tg2 = Issue fp ln ds (addTag fw (tg1++tg2)) - addTag Todo tgs = tgs- addTag fw tgs = (Tag $ show fw) : tgs+ addTag "todo" tgs = tgs+ addTag fw tgs = (Tag $ normaliseFlagword fw) : tgs
src/Lentil/Parse/Run.hs view
@@ -20,8 +20,6 @@ import Text.Parsec import Pipes -import Control.Applicative hiding (many, (<|>))- import qualified System.Directory as D import qualified Data.Functor.Identity as I import qualified System.ProgressBar as PB@@ -36,24 +34,26 @@ -- TYPES -- ----------- -type Cur = Int-type Tot = Int-type FilePathC = (FilePath, Cur, Tot)-+type FileNum = Int -- current file number+type TotNum = Int -- total file number +-----------+-- PIPES --+----------- -issueFinder :: [Alias] -> Pipe FilePathC [Issue] IO ()-issueFinder as = fpExist >->- fp2par as >->- fp2comm >->- cms2iss+issueFinder :: [Alias] -> [FlagWord] -> TotNum ->+ Pipe (FilePath, FileNum) [Issue] IO ()+issueFinder as fws tn = fpExist tn >->+ fp2par as >->+ fp2comm >->+ cms2iss where -- comm2Issues accepts Comment, we need [Comment] cms2iss = await >>= \(fp, cs) -> let tra = zip (repeat fp) cs in each tra >->- comm2Issues+ comm2Issues fws -- todo a function String -> [Issue] (w/o IO) [debug] [refactor] @@ -62,28 +62,27 @@ ----------- -- file exist check-fpExist :: Pipe FilePathC FilePath IO ()-fpExist = await >>= \(fp, k, t) ->- pbe k t >>- liftIO (D.doesFileExist fp) >>= \fb ->- if fb == False- then liftIO (perr $ fp ++ " : no such file")- else yield fp+fpExist :: TotNum -> Pipe (FilePath, FileNum) FilePath IO ()+fpExist t = await >>= \(fp, k) ->+ pbe k >>+ liftIO (D.doesFileExist fp) >>= \fb ->+ if fb == False+ then liftIO (perr $ fp ++ " : no such file")+ else yield fp where- fi i = fromIntegral i- lbl t = show t ++ " source files"- pb k t = PB.mkProgressBar (PB.msg $ lbl t)- PB.percentage 40 (fi k) (fi t)- pbe k t = CM.when (mod k 30 == 0 && t > 100)- (liftIO (perrEph $ pb k t))+ fi i = fromIntegral i+ lbl = show t ++ " source files"+ pb k = PB.mkProgressBar (PB.msg lbl)+ PB.percentage 40 (fi k) (fi t)+ pbe k = CM.when (mod k 30 == 0 && t > 100)+ (liftIO (perrEph $ pb k)) -- todo: <qptain> personally i don't like when the leading -- character of the progress bar is different [feeback] -- [request] -- pick appropriate parser (if exists)-fp2par :: [Alias] -> Pipe FilePath- (FilePath, ParSource [Comment]) IO ()+fp2par :: [Alias] -> Pipe FilePath (FilePath, ParSource [Comment]) IO () fp2par as = await >>= \fp -> case langParserAlias as fp of Nothing -> return ()@@ -94,16 +93,16 @@ fp2comm = await >>= \(fp, p) -> liftIO (safeRead fp) >>= \t -> - (runParPipe p fp t >-> -- todo: sicuramente c'è un modo più elegante- (await >>= \r -> -- e breve. Ah! quando mettono le- -- tuples section! [refactor] [duct]- yield (fp, r)))+ (runParPipe p fp () t >-> -- todo: sicuramente c'è un modo più+ (await >>= \r -> -- elegante e breve. Ah! quando+ -- mettono le tuples section!+ yield (fp, r))) -- [refactor] [duct] -comm2Issues :: Pipe (FilePath, Comment) [Issue] IO ()-comm2Issues = await >>= \(fp, (r, i)) ->- runParPipe (setRow r >> issues)- fp ('\n':i) >>- comm2Issues -- needed or will pick just head issue+comm2Issues :: [FlagWord] -> Pipe (FilePath, Comment) [Issue] IO ()+comm2Issues fws = await >>= \(fp, (r, i)) ->+ runParPipe (setRow r >> issues)+ fp fws ('\n':i) >>+ comm2Issues fws -- needed or will pick just head issue -----------------@@ -112,13 +111,13 @@ -- generic parsing -- -runParPipe :: (Stream i I.Identity t) => Parsec i () o ->- FilePath -> i ->+runParPipe :: (Stream i I.Identity t) => Parsec i s o ->+ FilePath -> s -> i -> Pipe ip o IO ()-runParPipe p fp i = case runParser p () fp i of- Left l -> liftIO (perr $ fp ++ " : parse error " ++- show l)- Right r -> yield r+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 -- issue parsing --
src/Lentil/Types.hs view
@@ -31,6 +31,9 @@ aliasSign :: String aliasSign = "%" +-- Flagwords are string (TODO, FIXME, etc.)+type FlagWord = String+ -- output format data Format = TagPop | Pretty | Csv | Comp | Xml deriving (Show, Eq, Enum, Bounded)
src/Main.hs view
@@ -28,16 +28,16 @@ short 'v' <> help "show version and copyright info" ) where- versionCopy = "\nlentil - frugal issue tracker, version 1.0.1.0\n\+ versionCopy = "\nlentil - frugal issue tracker, version 1.0.2.0\n\ \(C) 2015-2016 Francesco Ariis - http://www.ariis.it\n\ \released under the GNU General Public License v3\n" runLentil :: LOptions -> IO ()-runLentil lo = uncurry (findIssues (loAlias lo))- (loInExcl lo) >>= \is -> -- grab issues+runLentil lo = uncurry (findIssues (loAlias lo) (loFlagwords lo))+ (loInExcl lo) >>= \is -> -- grab issues let fil = filterAnd (loFilters lo) is -- filtered- -- ord = chainSorts fil (loSort lo) -- ordered+ -- ord = chainSorts fil (loSort lo) -- ordered -- todo leave sort out as now? [design] -- which function to use to output stuff (file/term)
test/Lentil/ArgsSpec.hs view
@@ -12,10 +12,11 @@ testOpt :: LOptions testOpt = LOptions (["alpha"], ["beta"]) Csv [filterFilepath "al", negFilter . filterTags $ "."]- [] [("qq","s")] (Just "foo.txt")+ [] [("qq","s")] ["hax", "ke"] (Just "foo.txt") ins :: [String]-ins = words "alpha --format csv -x beta -p al -t ^ --a qq-s --output foo.txt"+ins = words "alpha --format csv -x beta -p al -t ^ --a qq-s \+ \--output foo.txt -w Hax -w ke" -- out :: Maybe LOptions -- out = getParseResult .
test/Lentil/FileSpec.hs view
@@ -20,15 +20,15 @@ describe "findIssues" $ do it "scans directories to find issues" $- findIssues [] [bas ++ ""] [] >>= \fiss ->+ findIssues [] [] [bas ++ ""] [] >>= \fiss -> length fiss `shouldBe` 5 it "allows to add specific folders" $- findIssues [] [bas ++ ""] [] >>= \fiss ->- findIssues [] [bas ++ "fold-a/", bas ++ "fold-b",- bas ++ "fold-c"] [] >>= \fiss2 ->+ findIssues [] [] [bas ++ ""] [] >>= \fiss ->+ findIssues [] [] [bas ++ "fold-a/", bas ++ "fold-b",+ bas ++ "fold-c"] [] >>= \fiss2 -> length fiss `shouldBe` length fiss2 it "accepts filenames instead of dirs, too" $- findIssues [] [bas ++ "fold-a/foo1.hs"] [] >>= \fiss ->+ findIssues [] [] [bas ++ "fold-a/foo1.hs"] [] >>= \fiss -> length fiss `shouldBe` 1 -- it "doesn't duplicate issues" $@@ -37,23 +37,23 @@ -- TODO: excluding files fails on MS Windows! Check why! [u:3] [bug] it "excludes some folders" $- findIssues [] [bas ++ ""] [bas ++ "fold-c/"] >>= \fiss ->+ findIssues [] [] [bas ++ ""] [bas ++ "fold-c/"] >>= \fiss -> length fiss `shouldBe` 2 it "excludes files" $- findIssues [] [bas ++ ""] [bas ++ "fold-a/foo1.hs"] >>= \fiss ->+ findIssues [] [] [bas ++ ""] [bas ++ "fold-a/foo1.hs"] >>= \fiss -> length fiss `shouldBe` 4 it "excludes subfolders" $- findIssues [] [bas ++ "fold-c/"]+ findIssues [] [] [bas ++ "fold-c/"] [bas ++ "fold-c/sub-fold/"] >>= \fiss -> length fiss `shouldBe` 1 it "exludes . and _ folders" $- findIssues [] [fld ++ "dot-folders/"] [] >>= \fiss ->+ findIssues [] [] [fld ++ "dot-folders/"] [] >>= \fiss -> length fiss `shouldBe` 1 it "doesn't crash on wrong file" $- findIssues [] [bas ++ "zxczd"] [] >>= \fiss ->+ findIssues [] [] [bas ++ "zxczd"] [] >>= \fiss -> length fiss `shouldBe` 0 it "does search outside $PWD" $- findIssues [] [bas] [] >>= \fiss ->- findIssues [] [bas ++ "../base-case/"] [] >>= \fiss' ->+ findIssues [] [] [bas] [] >>= \fiss ->+ findIssues [] [] [bas ++ "../base-case/"] [] >>= \fiss' -> length fiss `shouldBe` length fiss'
test/Lentil/Parse/IssueSpec.hs view
@@ -13,9 +13,9 @@ -- Parsing tests -- simple parser (choosable if we are at begin of line or else)-sp :: ParIssue a -> String -> Maybe a-sp p cs = either (const Nothing) Just- (runParser p () fp cs)+sp :: [FlagWord] -> ParIssue a -> String -> Maybe a+sp fws p cs = either (const Nothing) Just+ (runParser p fws fp cs) where fp = "<f>" @@ -27,21 +27,29 @@ spec :: Spec spec = do + describe "normaliseFlagword" $ do+ it "normalises the capitalisation of a flag-word" $+ normaliseFlagword "TODO" `shouldBe` "todo"+ it "normalises capitalisation midword" $+ normaliseFlagword "tOdo" `shouldBe` "todo"+ it "correctly handles empty strings" $+ normaliseFlagword "" `shouldBe` ""+ describe "ciString" $ do it "parses a case insensitive string" $- sp (ciString "tEst") "Test" `shouldBe` Just "Test"+ sp [] (ciString "tEst") "Test" `shouldBe` Just "Test" describe "eoft" $ do it "parses a textfile end of file" $- sp (string "test" <* eoft) "test\n" `shouldBe` Just "test"+ sp [] (string "test" <* eoft) "test\n" `shouldBe` Just "test" it "or an eof without '\\n'" $- sp (string "test" <* eoft) "test" `shouldBe` Just "test"+ sp [] (string "test" <* eoft) "test" `shouldBe` Just "test" describe "blankline" $ do it "parses an empty line" $- sp blankline "\n\nlol" `shouldBe` Just ()+ sp [] blankline "\n\nlol" `shouldBe` Just () it "deals with eof blanklines too" $- sp blankline "\n" `shouldBe` Just ()+ sp [] blankline "\n" `shouldBe` Just () describe "htmlify" $ do it "removes unneeded whitespace" $@@ -51,106 +59,110 @@ describe "tag" $ do it "parses a tag" $- fmap tagString (sp tag "[test-tag]") `shouldBe` Just "test-tag"+ fmap tagString (sp [] tag "[test-tag]") `shouldBe` Just "test-tag" it "should not allow whitespace inside a tag" $- fmap tagString (sp tag "[broken tag]") `shouldBe` Nothing+ fmap tagString (sp [] tag "[broken tag]") `shouldBe` Nothing 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- -- sp incipit "\n Feature: " `shouldBe` Just Feature+ do sp [] incipit "\n TODO: " `shouldBe` Just "todo"+ sp [] incipit "\n FIXME: " `shouldBe` Just "fixme"+ sp [] incipit "\nXXX: " `shouldBe` Just "xxx"+ it "parses the initial section of an issue (user-defined flagword)" $+ sp ["feature"] incipit "\n Feature: " `shouldBe` Just "feature"+ it "parses the initial sect. (user-defined, normalising)" $+ sp ["feaTure"] incipit "\n Feature: " `shouldBe` Just "feature" it "doesn't work without previous newline" $- sp incipit "\nTODO:some" `shouldBe` Nothing+ sp [] incipit "\nTODO:some" `shouldBe` Nothing it "doesn't work with longer matches (todoodle)" $- sp incipit "\nTODOodle:some" `shouldBe` Nothing+ sp [] incipit "\nTODOodle:some" `shouldBe` Nothing it "doesn't work if you don't add a space after :" $- sp incipit "\nTODO:some" `shouldBe` Nothing+ sp [] incipit "\nTODO:some" `shouldBe` Nothing it "does allow you to omit the :" $- sp incipit "\nxxx some" `shouldBe` Just Xxx+ sp [] incipit "\nxxx some" `shouldBe` Just "xxx" it "is case unsensitive in flag-word" $- sp incipit "\ntOdO some" `shouldBe` Just Todo+ sp [] incipit "\ntOdO some" `shouldBe` Just "todo" it "doesn't allow anything before flag-words" $- sp incipit "so fixme someday" `shouldBe` Nothing+ sp [] incipit "so fixme someday" `shouldBe` Nothing it "fails if we are not at the beginning of line" $- sp incipit "so fixme someday" `shouldBe` Nothing+ sp [] incipit "so fixme someday" `shouldBe` Nothing describe "tags" $ do it "parses a series of tags, sep by whitespace" $- sp tags " [tag] [field:test] [tog]"+ sp [] tags " [tag] [field:test] [tog]" `shouldBe` Just [Tag "tag", Tag "field:test", Tag "tog"] it "allows ending whitespace" $- sp tags " [tag] [field:test] [tog] "+ sp [] tags " [tag] [field:test] [tog] " `shouldBe` Just [Tag "tag", Tag "field:test", Tag "tog"] describe "freeText" $ do it "parses a free form text" $- sp freeText "this is it\n\n" `shouldBe` Just (Just "this is it")+ sp [] freeText "this is it\n\n" `shouldBe` Just (Just "this is it") it "can be ended by tags/fields" $- sp freeText "this is it [field:val]" `shouldBe` Just (Just "this is it")+ sp [] freeText "this is it [field:val]" `shouldBe`+ Just (Just "this is it") it "trims extra whitespace" $- sp freeText "this is it [bug]" `shouldBe` Just (Just "this is it")+ sp [] freeText "this is it [bug]" `shouldBe` Just (Just "this is it") it "cannot be ended by new issue on same line" $- sp freeText "this is it TODO: desc\n" `shouldBe`+ sp [] freeText "this is it TODO: desc\n" `shouldBe` Just (Just "this is it TODO: desc") it "cannot be ended by new issue on new-but-not-beginning-of-line" $- sp freeText "this is it \nn TODO: desc\n" `shouldBe`+ sp [] freeText "this is it \nn TODO: desc\n" `shouldBe` Just (Just "this is it n TODO: desc") it "can be ended by blank line" $- sp freeText "this is it\n\n TODO: desc" `shouldBe`+ sp [] freeText "this is it\n\n TODO: desc" `shouldBe` Just (Just "this is it") it "can be ended by incomplete blank line (eof)" $- sp freeText "this is it\n" `shouldBe` Just (Just "this is it")+ sp [] freeText "this is it\n" `shouldBe` Just (Just "this is it") describe "issue" $ do it "parses an issue" $- sp issue "\n fixMe this is it [t] [f:w]"+ sp [] issue "\n fixMe this is it [t] [f:w]" `shouldBe` (Just $ Issue "<f>" 2 (Just "this is it") [Tag "fixme", Tag "t", Tag "f:w"]) it "parses tagless/fieldless issues too" $- sp issue "\nTODO: this is it\n"+ sp [] issue "\nTODO: this is it\n" `shouldBe` (Just $ Issue "<f>" 2 (Just "this is it") []) it "parses an issue not ended by \\n" $- sp issue "\ntodo block1 "+ sp [] issue "\ntodo block1 " `shouldBe` (Just $ Issue "<f>" 2 (Just "block1") []) it "doesn't display the eventual \\n at eof" $- sp issue "\nTOdO: this is it\n"+ sp [] issue "\nTOdO: this is it\n" `shouldBe` (Just $ Issue "<f>" 2 (Just "this is it") []) it "does accept a lone (naked) todo" $- sp issue "\ntodo\n"+ sp [] issue "\ntodo\n" `shouldBe` (Just $ Issue "<f>" 2 Nothing []) it "issues declared with fixme get a free [fixme] tag" $- sp issue "\nfixme blah\n"+ sp [] issue "\nfixme blah\n" `shouldBe` (Just $ Issue "<f>" 2 (Just "blah") [Tag "fixme"]) it "doesn't parse tags non separated by a space" $- sp issue "\ntodo blah[f]\n"+ sp [] issue "\ntodo blah[f]\n" `shouldBe` (Just $ Issue "<f>" 2 (Just "blah[f]") []) it "does parse an empty todo" $- sp issue "\ntodo\n"+ sp [] issue "\ntodo\n" `shouldBe` (Just $ Issue "<f>" 2 Nothing []) it "does parse an empty fixme" $- sp issue "\nfixme \n"+ sp [] issue "\nfixme \n" `shouldBe` (Just $ Issue "<f>" 2 Nothing [Tag "fixme"]) it "does parse an empty todo + tags" $- sp issue "\ntodo [alfa]\n"+ sp [] issue "\ntodo [alfa]\n" `shouldBe` (Just $ Issue "<f>" 2 Nothing [Tag "alfa"]) it "does parse tags before description" $- sp issue "\ntodo [alfa] beta\n"+ sp [] issue "\ntodo [alfa] beta\n" `shouldBe` (Just $ Issue "<f>" 2 (Just "beta") [Tag "alfa"]) describe "issues" $ do it "parses multiple issues" $- sp issues "\nTODO: this is it [f:w]\n TODO: hey [t]"+ sp [] issues "\nTODO: this is it [f:w]\n TODO: hey [t]" `shouldBe` Just [Issue "<f>" 2 (Just "this is it") [Tag "f:w"], Issue "<f>" 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]"+ sp [] issues "\nTODO: this is it [f:w] TODO: hey [t]" `shouldBe` Just [Issue "<f>" 2 (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]"+ sp [] issues "\nTODO: this is it \n todo hey [t]" `shouldBe` Just [Issue "<f>" 2 (Just "this is it") [], Issue "<f>" 3 (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 [])+ sp [] issues "\nthis is not a todo as you can see" `shouldBe` (Just [])
test/Lentil/Parse/RunSpec.hs view
@@ -2,11 +2,9 @@ import Test.Hspec import Pipes-import Text.Parsec ( runParser ) import Lentil.Types import Lentil.Parse.Run-import Lentil.Parse.Source import qualified Pipes.Prelude as PP @@ -14,15 +12,12 @@ -- Parsing tests --- simple parser (choosable if we are at begin of line or else)-sp :: ParSource a -> String -> Maybe a-sp p cs = either (const Nothing) Just- (runParser p () fp cs)- where fp = "<f>"+fileParser :: [Alias] -> [FlagWord] -> FilePath -> IO [Issue]+fileParser as fws fp = fmap concat (PP.toListM myPipe)+ where+ myPipe = yield (fp, 1) >-> issLoop+ issLoop = issueFinder as fws 1 >> issLoop -fileParser :: [Alias] -> FilePath -> IO [Issue]-fileParser as fp = fmap concat (PP.toListM $ yield (fp, 0, 0) >-> issLoop)- where issLoop = issueFinder as >> issLoop main :: IO () main = hspec spec@@ -39,48 +34,62 @@ describe "issueFinder - specific" $ do it "doesn't parse contiguous line/block as a single issue" $- fileParser [] "test/test-files/specific/contiguous.c"+ fileParser [] [] "test/test-files/specific/contiguous.c" `shouldReturn` [Issue "test/test-files/specific/contiguous.c" 1 (Just "issue1") []]+ it "contiguous line/block is not single issue (custom flagwords)" $+ fileParser [] ["hax"] "test/test-files/specific/cont-custom.c"+ `shouldReturn` [Issue "test/test-files/specific/cont-custom.c" 1+ (Just "single") [],+ Issue "test/test-files/specific/cont-custom.c" 2+ (Just "single2") [Tag "hax"]] it "does parse files with uppercase extension" $- fileParser [] "test/test-files/specific/uppercase.C"+ fileParser [] [] "test/test-files/specific/uppercase.C" `shouldReturn` spt "test/test-files/specific/uppercase.C"+ it "parses a .xyz file as if it were a .c file" $+ fileParser [(".xyz", ".c")] [] "test/test-files/specific/xyz.xyz"+ `shouldReturn` spt "test/test-files/specific/xyz.xyz"+ it "parses user-defined flagword" $+ let custFlw fp = [Issue fp 3 (Just "single2") [Tag "hax"]] in+ fileParser [] ["hax"] "test/test-files/specific/custom-fwords.c"+ `shouldReturn` custFlw "test/test-files/specific/custom-fwords.c"+ it "parses user-defined flagword (CI)" $+ let custFlw fp = [Issue fp 3 (Just "single2") [Tag "hax"]] in+ fileParser [] ["hAx"] "test/test-files/specific/custom-fwords.c"+ `shouldReturn` custFlw "test/test-files/specific/custom-fwords.c" describe "commentParser - languages" $ do it "parses a plain text source" $- fileParser [] "test/test-files/lang-comm/text.txt"+ fileParser [] [] "test/test-files/lang-comm/text.txt" `shouldReturn` spt "test/test-files/lang-comm/text.txt" it "parses a haskell source" $- fileParser [] "test/test-files/lang-comm/haskell.hs"+ fileParser [] [] "test/test-files/lang-comm/haskell.hs" `shouldReturn` spt "test/test-files/lang-comm/haskell.hs" it "parses a C source" $- fileParser [] "test/test-files/lang-comm/clang.c"+ fileParser [] [] "test/test-files/lang-comm/clang.c" `shouldReturn` spt "test/test-files/lang-comm/clang.c" it "parses a Pascal source" $- fileParser [] "test/test-files/lang-comm/pascal.pas"+ fileParser [] [] "test/test-files/lang-comm/pascal.pas" `shouldReturn` spt "test/test-files/lang-comm/pascal.pas" it "parses a javascript source" $- fileParser [] "test/test-files/lang-comm/javascript.js"+ fileParser [] [] "test/test-files/lang-comm/javascript.js" `shouldReturn` spt "test/test-files/lang-comm/javascript.js" it "parses a python source" $- fileParser [] "test/test-files/lang-comm/python.py"+ fileParser [] [] "test/test-files/lang-comm/python.py" `shouldReturn` spt "test/test-files/lang-comm/python.py" it "parses a ruby source" $- fileParser [] "test/test-files/lang-comm/ruby.rb"+ fileParser [] [] "test/test-files/lang-comm/ruby.rb" `shouldReturn` spt "test/test-files/lang-comm/ruby.rb" it "parses a perl source" $- fileParser [] "test/test-files/lang-comm/perl.pl"+ fileParser [] [] "test/test-files/lang-comm/perl.pl" `shouldReturn` spt "test/test-files/lang-comm/perl.pl" it "parses a shell script source" $- fileParser [] "test/test-files/lang-comm/shell.sh"+ fileParser [] [] "test/test-files/lang-comm/shell.sh" `shouldReturn` spt "test/test-files/lang-comm/shell.sh" it "parses a Nix source" $- fileParser [] "test/test-files/lang-comm/nix.nix"+ fileParser [] [] "test/test-files/lang-comm/nix.nix" `shouldReturn` spt "test/test-files/lang-comm/nix.nix" it "parses an Xml source" $- fileParser [] "test/test-files/lang-comm/xml.xml"+ fileParser [] [] "test/test-files/lang-comm/xml.xml" `shouldReturn` spt "test/test-files/lang-comm/xml.xml"- it "parses a .xyz file as if it were a .c file" $- fileParser [(".xyz", ".c")] "test/test-files/lang-comm/xyz.xyz"- `shouldReturn` spt "test/test-files/lang-comm/xyz.xyz"
− test/test-files/lang-comm/xyz.xyz
@@ -1,12 +0,0 @@-// todo single-// comment-// Todo: single2--var c = "st/*ring"; // string-char letter = 'c' // char--/* TODO: block1 */-/* TODO: block2 [tog] */---// end
+ test/test-files/specific/cont-custom.c view
@@ -0,0 +1,4 @@+// todo single+// Hax: single2++// end
+ test/test-files/specific/custom-fwords.c view
@@ -0,0 +1,5 @@+// single+// comment+// Hax: single2++// end
+ test/test-files/specific/xyz.xyz view
@@ -0,0 +1,12 @@+// todo single+// comment+// Todo: single2++var c = "st/*ring"; // string+char letter = 'c' // char++/* TODO: block1 */+/* TODO: block2 [tog] */+++// end