diff --git a/changes.txt b/changes.txt
--- a/changes.txt
+++ b/changes.txt
@@ -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
-------
diff --git a/doc/usr/page.rst b/doc/usr/page.rst
--- a/doc/usr/page.rst
+++ b/doc/usr/page.rst
@@ -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
+
+
+
+Recognised files
+----------------
+
As now lentil parses:
- haskell source files (``.hs``, ``.lhs``, ``.chs``, ``.hsc``, ``.cabal``)
diff --git a/issues.txt b/issues.txt
--- a/issues.txt
+++ b/issues.txt
@@ -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 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]
diff --git a/lentil.cabal b/lentil.cabal
--- a/lentil.cabal
+++ b/lentil.cabal
@@ -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,
diff --git a/src/Lentil/Args.hs b/src/Lentil/Args.hs
--- a/src/Lentil/Args.hs
+++ b/src/Lentil/Args.hs
@@ -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)
diff --git a/src/Lentil/File.hs b/src/Lentil/File.hs
--- a/src/Lentil/File.hs
+++ b/src/Lentil/File.hs
@@ -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
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
@@ -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
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
@@ -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: 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 --
diff --git a/src/Lentil/Types.hs b/src/Lentil/Types.hs
--- a/src/Lentil/Types.hs
+++ b/src/Lentil/Types.hs
@@ -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)
diff --git a/src/Main.hs b/src/Main.hs
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -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)
diff --git a/test/Lentil/ArgsSpec.hs b/test/Lentil/ArgsSpec.hs
--- a/test/Lentil/ArgsSpec.hs
+++ b/test/Lentil/ArgsSpec.hs
@@ -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 .
diff --git a/test/Lentil/FileSpec.hs b/test/Lentil/FileSpec.hs
--- a/test/Lentil/FileSpec.hs
+++ b/test/Lentil/FileSpec.hs
@@ -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'
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
@@ -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 = ""
@@ -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 "" 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 "" 2 (Just "this is it") [])
it "parses an issue not ended by \\n" $
- sp issue "\ntodo block1 "
+ sp [] issue "\ntodo block1 "
`shouldBe` (Just $ Issue "" 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 "" 2 (Just "this is it") [])
it "does accept a lone (naked) todo" $
- sp issue "\ntodo\n"
+ sp [] issue "\ntodo\n"
`shouldBe` (Just $ Issue "" 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 "" 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 "" 2 (Just "blah[f]") [])
it "does parse an empty todo" $
- sp issue "\ntodo\n"
+ sp [] issue "\ntodo\n"
`shouldBe` (Just $ Issue "" 2 Nothing [])
it "does parse an empty fixme" $
- sp issue "\nfixme \n"
+ sp [] issue "\nfixme \n"
`shouldBe` (Just $ Issue "" 2 Nothing [Tag "fixme"])
it "does parse an empty todo + tags" $
- sp issue "\ntodo [alfa]\n"
+ sp [] issue "\ntodo [alfa]\n"
`shouldBe` (Just $ Issue "" 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 "" 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 "" 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]"
+ sp [] issues "\nTODO: this is it [f:w] TODO: hey [t]"
`shouldBe` Just [Issue "" 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 "" 2 (Just "this is it") [],
Issue "" 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 [])
diff --git a/test/Lentil/Parse/RunSpec.hs b/test/Lentil/Parse/RunSpec.hs
--- a/test/Lentil/Parse/RunSpec.hs
+++ b/test/Lentil/Parse/RunSpec.hs
@@ -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 = ""
+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"
diff --git a/test/test-files/lang-comm/xyz.xyz b/test/test-files/lang-comm/xyz.xyz
deleted file mode 100644
--- a/test/test-files/lang-comm/xyz.xyz
+++ /dev/null
@@ -1,12 +0,0 @@
-// todo single
-// comment
-// Todo: single2
-
-var c = "st/*ring"; // string
-char letter = 'c' // char
-
-/* TODO: block1 */
-/* TODO: block2 [tog] */
-
-
-// end
diff --git a/test/test-files/specific/cont-custom.c b/test/test-files/specific/cont-custom.c
new file mode 100644
--- /dev/null
+++ b/test/test-files/specific/cont-custom.c
@@ -0,0 +1,4 @@
+// todo single
+// Hax: single2
+
+// end
diff --git a/test/test-files/specific/custom-fwords.c b/test/test-files/specific/custom-fwords.c
new file mode 100644
--- /dev/null
+++ b/test/test-files/specific/custom-fwords.c
@@ -0,0 +1,5 @@
+// single
+// comment
+// Hax: single2
+
+// end
diff --git a/test/test-files/specific/xyz.xyz b/test/test-files/specific/xyz.xyz
new file mode 100644
--- /dev/null
+++ b/test/test-files/specific/xyz.xyz
@@ -0,0 +1,12 @@
+// todo single
+// comment
+// Todo: single2
+
+var c = "st/*ring"; // string
+char letter = 'c' // char
+
+/* TODO: block1 */
+/* TODO: block2 [tog] */
+
+
+// end