difftodo 0.1.0 → 0.2.0
raw patch · 13 files changed
+408/−253 lines, 13 filesdep +highlighter2dep +pretty-showdep +processdep −highlighting-katenew-component:exe:diff-todonew-component:exe:git-todoPVP ok
version bump matches the API change (PVP)
Dependencies added: highlighter2, pretty-show, process
Dependencies removed: highlighting-kate
API changes (from Hackage documentation)
- Fixme.Comment: parseComments' :: [SourceLine] -> [Comment]
+ Fixme: readComments :: FilePath -> Maybe (IO [Comment])
+ Fixme.Comment: filename :: Located a -> Filename
+ Fixme.Comment: instance GHC.Base.Functor Fixme.Comment.Located
+ Fixme.Comment: locatedValue :: Located a -> a
+ Fixme.Comment: readComments :: FilePath -> Maybe (IO [Comment])
- Fixme: parseComments :: Language -> Text -> [Comment]
+ Fixme: parseComments :: Filename -> Language -> ByteString -> [Comment]
- Fixme.Comment: commentText :: Comment -> Text
+ Fixme.Comment: commentText :: Comment -> ByteString
- Fixme.Comment: highlightCode :: Language -> Text -> [SourceLine]
+ Fixme.Comment: highlightCode :: Language -> ByteString -> [Token]
- Fixme.Comment: languageForFile :: Text -> Maybe Language
+ Fixme.Comment: languageForFile :: FilePath -> Maybe Language
- Fixme.Comment: newComment :: Int -> Text -> Comment
+ Fixme.Comment: newComment :: Filename -> Int -> ByteString -> Comment
- Fixme.Comment: parseComments :: Language -> Text -> [Comment]
+ Fixme.Comment: parseComments :: Filename -> Language -> ByteString -> [Comment]
- Fixme.Comment: type Comment = Located Text
+ Fixme.Comment: type Comment = Located ByteString
- Fixme.Comment: type Language = Text
+ Fixme.Comment: type Language = Lexer
Files
- all-todos/Main.hs +0/−59
- cmd/all-todos/Main.hs +48/−0
- cmd/diff-todo/Main.hs +25/−0
- cmd/git-todo/Main.hs +114/−0
- difftodo.cabal +41/−5
- src/Fixme.hs +1/−0
- src/Fixme/Comment.hs +74/−46
- src/Fixme/Diff.hs +9/−7
- src/Fixme/Todo.hs +13/−5
- tests/Comment.hs +54/−127
- tests/Diff.hs +2/−2
- tests/Main.hs +4/−2
- tests/Todo.hs +23/−0
− all-todos/Main.hs
@@ -1,59 +0,0 @@--- | Get todos from source code------ e.g.--- all-todos foo.py--module Main (main) where--import Protolude--import Data.Text.IO (readFile)-import GHC.IO (FilePath)-import Options.Applicative- ( ParserInfo- , argument- , execParser- , fullDesc- , header- , helper- , info- , metavar- , progDesc- , str- )--import qualified Fixme-import Fixme.Comment (Comment, languageForFile)---options :: ParserInfo [FilePath]-options =- info (helper <*> parser) description- where- parser = many (argument str (metavar "FILES..."))-- description = mconcat- [ fullDesc- , progDesc "Find all todos from source code"- , header "all-todos - Get all todos in source code"- ]---readComments :: FilePath -> IO (Maybe [Comment])-readComments filename =- case languageForFile (toS filename) of- Nothing -> pure Nothing- Just language -> do- contents <- readFile filename- pure (Just $ Fixme.parseComments language contents)---main :: IO ()-main = do- files <- execParser options- forM_ files $ \filename -> do- comments' <- readComments filename- case comments' of- Nothing -> pure ()- Just comments -> do- mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)
+ cmd/all-todos/Main.hs view
@@ -0,0 +1,48 @@+-- | Get todos from source code+--+-- e.g.+-- all-todos foo.py++module Main (main) where++import Protolude++import GHC.IO (FilePath)+import Options.Applicative+ ( ParserInfo+ , argument+ , execParser+ , fullDesc+ , header+ , helper+ , info+ , metavar+ , progDesc+ , str+ )++import qualified Fixme+++options :: ParserInfo [FilePath]+options =+ info (helper <*> parser) description+ where+ parser = many (argument str (metavar "FILES..."))++ description = mconcat+ [ fullDesc+ , progDesc "Find all todos from source code"+ , header "all-todos - Get all todos in source code"+ ]+++main :: IO ()+main = do+ files <- execParser options+ comments <- concatMapM commentsFrom files+ mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)+ where+ -- If we can't figure out the language, then just assume it has no+ -- comments of interest.+ commentsFrom path = fromMaybe (pure []) (Fixme.readComments path)
+ cmd/diff-todo/Main.hs view
@@ -0,0 +1,25 @@+-- | Get todos from diffs+--+-- e.g.+-- git diff master... | diff-todo++module Main (main) where++import Protolude++import Data.ByteString (hGetContents)+import Data.Text.IO (hPutStrLn)+import System.IO (stdin, stderr)++import qualified Fixme+++main :: IO ()+main = do+ diff <- hGetContents stdin+ case Fixme.newCommentsFromDiff diff of+ Left e -> do+ hPutStrLn stderr $ "ERROR: " <> e+ exitWith (ExitFailure 1)+ Right comments ->+ mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)
+ cmd/git-todo/Main.hs view
@@ -0,0 +1,114 @@+-- | Get todos from git+--+-- Use git-todo to find all of the TODOs in a git repository.+--+-- e.g.+--+-- To see all the todos added between your working tree and HEAD:+-- $ git todo+--+-- To see all the todos in your branch:+-- $ git todo origin/master+--+-- To see all the todos in your code base:+-- $ git todo --files+--+-- git-todo arguments behave like git-diff arguments, unless --files is+-- specified, in which case they act like git-ls-files arguments.++-- TODO: `git todo --help` doesn't work because it needs a manpage. Try to+-- make it work somehow.++module Main (main) where++import Protolude++import qualified Data.Text as Text+import Data.Text.IO (hPutStrLn)+import GHC.IO (FilePath)+import Options.Applicative+ ( ParserInfo+ , argument+ , execParser+ , flag+ , fullDesc+ , header+ , help+ , helper+ , info+ , long+ , metavar+ , progDesc+ , short+ , switch+ , str+ )+import System.IO (stderr)+import System.Process (readProcess)++import qualified Fixme+import Fixme.Comment (Comment)+++data Config = Diff Bool [FilePath] | Files [FilePath] deriving (Eq, Show)++options :: ParserInfo Config+options =+ info (helper <*> parser) description+ where+ parser = modeFlag <*> cachedFlag <*> many (argument str (metavar "FILES..."))++ modeFlag = flag Diff (const Files) (mconcat [ long "files"+ , short 'f'+ , help "Show all todos in source files instead of examining diffs"+ ])+ cachedFlag = switch (mconcat [ long "cached"+ , help "Get todos from changes staged for next commit, optionally relative to another commit. Ignored if --files is set."+ ])+ description = mconcat+ [ fullDesc+ , progDesc "Get todos from source code in git"+ , header "git-todo - Get todos from source code in git"+ ]++commentsFromDiff :: [FilePath] -> IO [Comment]+commentsFromDiff args =+ either abort pure . Fixme.newCommentsFromDiff =<< gitDiff args+ where+ abort e = do+ hPutStrLn stderr $ "ERROR: " <> e+ exitWith (ExitFailure 1)++commentsFromFiles :: [FilePath] -> IO [Comment]+commentsFromFiles paths =+ concatMapM commentsFrom =<< gitListFiles paths+ where+ -- If we can't figure out the language, then just assume it has no+ -- comments of interest.+ commentsFrom path = fromMaybe (pure []) (Fixme.readComments path)++-- TODO: Use gitlib++-- | Run `git diff <diffspec>` in the current working directory.+gitDiff :: [FilePath] -> IO ByteString+gitDiff args = toS <$> readProcess "git" ("diff":args) ""++-- TODO: Factor out todo reporting++-- | Run `git ls-files` with the given files in the current working directory.+gitListFiles :: [FilePath] -> IO [FilePath]+gitListFiles files =+ -- TODO: Don't assume git repo location is CWD+ toLines <$> readProcess "git" ("ls-files":files) ""+ where+ toLines = map toS . Text.lines . toS+++main :: IO ()+main = do+ config <- execParser options+ comments <- case config of+ Diff False args -> commentsFromDiff args+ Diff True args -> commentsFromDiff ("--cached":args)+ Files args -> commentsFromFiles args+ mapM_ (putStrLn . Fixme.formatTodo) (concatMap Fixme.getTodos comments)
difftodo.cabal view
@@ -1,10 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.13.0.+-- This file has been generated from package.yaml by hpack version 0.14.0. -- -- see: https://github.com/sol/hpack name: difftodo-version: 0.1.0+version: 0.2.0 synopsis: Generate todo lists from source code+description: See README.md for details category: Development homepage: https://github.com/jml/difftodo#readme bug-reports: https://github.com/jml/difftodo/issues@@ -27,8 +28,9 @@ base >= 4.9 && < 5 , protolude >= 0.1.5 , text+ , bytestring , diff-parse- , highlighting-kate+ , highlighter2 exposed-modules: Fixme Fixme.Comment@@ -39,7 +41,7 @@ executable all-todos main-is: Main.hs hs-source-dirs:- all-todos+ cmd/all-todos default-extensions: NoImplicitPrelude OverloadedStrings NamedFieldPuns RecordWildCards ghc-options: -Wall build-depends:@@ -50,6 +52,38 @@ , optparse-applicative default-language: Haskell2010 +executable diff-todo+ main-is: Main.hs+ hs-source-dirs:+ cmd/diff-todo+ default-extensions: NoImplicitPrelude OverloadedStrings NamedFieldPuns RecordWildCards+ ghc-options: -Wall+ build-depends:+ base >= 4.9 && < 5+ , protolude >= 0.1.5+ , text+ , bytestring+ , difftodo+ , optparse-applicative+ default-language: Haskell2010++executable git-todo+ main-is: Main.hs+ hs-source-dirs:+ cmd/git-todo+ default-extensions: NoImplicitPrelude OverloadedStrings NamedFieldPuns RecordWildCards+ ghc-options: -Wall+ build-depends:+ base >= 4.9 && < 5+ , protolude >= 0.1.5+ , text+ , bytestring+ , difftodo+ , optparse-applicative+ , process+ , text+ default-language: Haskell2010+ test-suite fixme-tests type: exitcode-stdio-1.0 main-is: Main.hs@@ -62,11 +96,13 @@ , protolude >= 0.1.5 , text , bytestring- , highlighting-kate , difftodo+ , highlighter2+ , pretty-show , tasty , tasty-hunit other-modules: Comment Diff+ Todo default-language: Haskell2010
src/Fixme.hs view
@@ -6,6 +6,7 @@ ( -- | Get comments from code or from diffs Comment.parseComments , Diff.newCommentsFromDiff+ , Comment.readComments -- | Turn comments into todos , Todo.getTodos -- | Format todos
src/Fixme/Comment.hs view
@@ -1,14 +1,17 @@ module Fixme.Comment ( -- * Understand comments Comment- , Located , parseComments+ , readComments , commentText+ , filename , startLine , endLine+ -- ** Generic support for things located in files+ , Located+ , locatedValue -- ** Exposed for testing , newComment- , parseComments' -- * Understand programming languages , Language@@ -19,26 +22,27 @@ import Protolude -import qualified Data.Text as Text-import Text.Highlighting.Kate- ( SourceLine- , Token+import qualified Data.ByteString as ByteString+import GHC.IO (FilePath)+import Text.Highlighter+ ( lexerFromFilename+ , runLexer+ , Lexer+ , Token(..) , TokenType(..)- , highlightAs- , languagesByFilename ) -- | Given some source code, return a list of comments.-parseComments :: Language -> Text -> [Comment]-parseComments language = parseComments' . highlightCode language+parseComments :: Filename -> Language -> ByteString -> [Comment]+parseComments filename language = parseComments' filename . highlightCode language -- | Given a consecutive sequence of lexed lines of source, return a list of -- all the comments found, along with the line number on which the comment -- starts.-parseComments' :: [SourceLine] -> [Comment]-parseComments' =- coalesce appendComment . mapMaybe getComment . locateTokens+parseComments' :: Filename -> [Token] -> [Comment]+parseComments' filename =+ coalesce appendComment . mapMaybe getComment . locateTokens filename where coalesce :: (a -> a -> Maybe a) -> [a] -> [a]@@ -49,63 +53,87 @@ coalesce _ xs = xs +-- | Read the given file, and parse out any comments.+--+-- Return Nothing if we cannot determine what language the file is in. Raises+-- exceptions on bad IO, and also if the file cannot be decoded to Text.+readComments :: FilePath -> Maybe (IO [Comment])+readComments filename =+ case languageForFile (toS filename) of+ Nothing -> Nothing+ Just language -> Just $ do+ contents <- ByteString.readFile filename+ pure (parseComments (Just (toS filename)) language contents)++ -- | A thing that is located somewhere in a text file.-data Located a = Located { startLine :: Int- , value :: a+data Located a = Located { filename :: Filename+ , startLine :: Int+ , locatedValue :: a } deriving (Eq, Show) -type LocatedToken = Located Token+instance Functor Located where+ fmap f (Located fn start x) = Located fn start (f x) -locateTokens :: [SourceLine] -> [LocatedToken]-locateTokens lines = [Located i x | (i, xs) <- zip [0..] lines, x <- xs]+-- | How we identify which blob of text a thing is located in.+type Filename = Maybe Text +locateTokens :: Filename -> [Token] -> [Located Token]+locateTokens fn tokens =+ [ Located fn i t | (i, t) <- zip startLines tokens ]+ where+ startLines = scanl (+) 0 [ numLines value | Token _ value <- tokens ] -type Comment = Located Text+numLines :: ByteString -> Int+numLines = ByteString.count newline+ where newline = fromIntegral (ord '\n') -commentText :: Comment -> Text-commentText = value+type Comment = Located ByteString -newComment :: Int -> Text -> Comment-newComment i text = Located i text+-- XXX: Rename commentText to be less misleading about type+commentText :: Comment -> ByteString+commentText = locatedValue +newComment :: Filename -> Int -> ByteString -> Comment+newComment fn i text = Located fn i text+ endLine :: Comment -> Int-endLine (Located startLine c) = startLine + (Text.count "\n" c)+endLine (Located _ startLine c) = startLine + (numLines c) appendComment :: Comment -> Comment -> Maybe Comment appendComment x y+ | filename x /= filename y = Nothing | startLine y - endLine x > 1 = Nothing- | startLine y - endLine x == 1 = Just (newComment (startLine x) (commentText x <> "\n" <> commentText y))- | otherwise = Just (newComment (startLine x) (commentText x <> commentText y))+ | startLine y - endLine x == 1 = Just (newComment (filename x) (startLine x) (commentText x <> "\n" <> commentText y))+ | otherwise = Just (newComment (filename x) (startLine x) (commentText x <> commentText y)) -getComment :: LocatedToken -> Maybe Comment-getComment (Located lineNum token) =+getComment :: Located Token -> Maybe Comment+getComment (Located filename lineNum token) = case getComment' token of Nothing -> Nothing- Just comment -> Just $ Located lineNum comment+ Just comment -> Just $ Located filename lineNum comment -getComment' :: Token -> Maybe Text-getComment' (AlertTok, value) = Just (toS value)-getComment' (CommentTok, value) = Just (toS value)-getComment' _ = Nothing+ where+ getComment' :: Token -> Maybe ByteString+ getComment' (Token tType value) = bool Nothing (Just value) (isComment tType) + isComment Comment = True+ isComment (Arbitrary "Comment") = True+ isComment (x :. y) = isComment x || isComment y+ isComment _ = False + -- | Wrappers around syntax highlighting code. -- TODO: Move these to a separate module, maybe. -type Language = Text+type Language = Lexer -languageForFile :: Text -> Maybe Language-languageForFile = fmap toS . head . languagesByFilename . toS+languageForFile :: FilePath -> Maybe Language+languageForFile = lexerFromFilename -highlightCode :: Language -> Text -> [SourceLine]+highlightCode :: Language -> ByteString -> [Token] highlightCode language code =- let highlighted = highlightAs (toS language) (toS code)- in case Text.toLower language of- "haskell" -> map fixupHaskellComments highlighted- _ -> highlighted-- where- -- | For some reason, Kate highlights a Haskell comment with no text (i.e.- -- "--") as a function. Fix this up.- fixupHaskellComments = map (\t -> if t == (FunctionTok, "--") then (CommentTok, "--") else t)+ case runLexer language code of+ Left _ -> []+ Right tokens -> tokens
src/Fixme/Diff.hs view
@@ -6,6 +6,7 @@ import Protolude +import qualified Data.ByteString as ByteString import qualified Data.Text as Text import Text.Diff.Parse (parseDiff) import Text.Diff.Parse.Types@@ -32,15 +33,16 @@ -- Silently ignores files if we can't figure out what their programming -- language is. newCommentsFromDiff :: ByteString -> Either Text [Comment]-newCommentsFromDiff =- bimap toS (join . catMaybes . map getNewCommentsForFile) . parseDiff .toS+newCommentsFromDiff diff+ | ByteString.null diff = Right []+ | otherwise = bimap toS (join . catMaybes . map getNewCommentsForFile) . parseDiff . toS $ diff where getNewCommentsForFile (FileDelta Deleted _ _ _) = Just [] getNewCommentsForFile (FileDelta _ _ _ Binary) = Just [] getNewCommentsForFile (FileDelta _ _ filename (Hunks hunks)) =- case languageForFile filename of+ case languageForFile (toS filename) of Nothing -> Nothing- Just language -> Just $ concatMap (getNewCommentsForHunk language) hunks+ Just language -> Just $ concatMap (getNewCommentsForHunk filename language) hunks -- | Retrieve all the comments that were either added or modified in 'hunk'.@@ -60,9 +62,9 @@ -- comment, then it *might* be a pending todo -- -- Here, "comment" means a contiguous sequence of comment tokens.-getNewCommentsForHunk :: Language -> Hunk -> [Comment]-getNewCommentsForHunk language hunk =- let comments = parseComments language afterText+getNewCommentsForHunk :: Text -> Language -> Hunk -> [Comment]+getNewCommentsForHunk filename language hunk =+ let comments = parseComments (Just filename) language (toS afterText) in filterInsertions addedLineNumbers comments where -- | Reconstitute the "after" text of the diff hunk.
src/Fixme/Todo.hs view
@@ -8,18 +8,26 @@ import Protolude import qualified Data.Text as Text-import Fixme.Comment (Comment, Located, commentText)-+import Fixme.Comment (Comment, Located, commentText, filename, startLine, locatedValue) type Todo = Located Text +todoText :: Todo -> Text+todoText = locatedValue++ getTodos :: Comment -> [Todo] getTodos comment =- if any (`Text.isInfixOf` commentText comment) defaultTags then- [comment] else []+ if any (`Text.isInfixOf` (toS (commentText comment))) defaultTags then+ [toS <$> comment] else [] formatTodo :: Todo -> Text-formatTodo = ((<>) "\n") . commentText+formatTodo todo =+ fn <> ":" <> lineNum <> ":\n" <> indentedComment+ where+ fn = maybe "<unknown>" identity (filename todo)+ lineNum = show (startLine todo)+ indentedComment = Text.unlines (map (" " <>) (Text.lines (todoText todo))) defaultTags :: [Text] defaultTags = [ "XXX"
tests/Comment.hs view
@@ -2,14 +2,21 @@ import Protolude -import Data.Text (stripEnd, unlines)+import qualified Data.ByteString as ByteString+import Data.ByteString.Char8 (unlines)+import Data.Maybe (fromJust) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit--import Text.Highlighting.Kate (TokenType(..))+import Text.Highlighter+ ( lexerFromFilename+ , shortName+ , Token(..)+ , TokenType(..)+ )+import Text.Show.Pretty (ppShow) import Fixme.Comment- ( parseComments'+ ( Language , parseComments , newComment , highlightCode@@ -19,104 +26,18 @@ tests :: TestTree tests = testGroup "Fixme.Comment"- [ testGroup "Text.Highlighting.Kate"+ [ -- | Exploratory tests that show how our underlying lexer actually works.+ testGroup "Text.Highlighter" [ testCase "parse python" $ do- let lexed = highlightCode "python" (toS pythonExample)- let expected = [ [(CommentTok,"# first comment")]- , []- , [(CommentTok,"# second comment")]- , [(CommentTok,"# is multi-line")]- , []- , [(DecValTok,"1"),(NormalTok," "),(OperatorTok,"+"),(NormalTok," "),(DecValTok,"2"),(NormalTok," "),(CommentTok,"# trailing comment")]- ]- expected @=? lexed- , testCase "parse haskell" $ do- let lexed = highlightCode "haskell" (toS haskellExample)- let expected = [ [(CommentTok,"-- first comment")]- , []- , [(CommentTok,"-- second comment")]- , [(CommentTok,"-- is multi-line")]- , []- , [(CommentTok,"{- comment block start")]- , [(CommentTok,"continues")]- , [(CommentTok,"ends -}")]- , []- , [ (NormalTok,"f "),(FunctionTok,"="),(NormalTok," "),(CommentTok,"{- foo -}"),(NormalTok," ")- , (StringTok,"\"bar\""),(NormalTok," "),(CommentTok,"{- baz -}"),(NormalTok," ")- , (CommentTok,"-- qux")- ]- ]- expected @=? lexed- , testCase "parse indented haskell" $ do- let lexed = highlightCode "haskell" (toS indentedHaskellExample)- let expected = [ [(CommentTok,"-- first comment")]- , []- , [(NormalTok," "),(NormalTok," "),(CommentTok,"-- second comment")]- , [(NormalTok," "),(NormalTok," "),(CommentTok,"-- is multi-line")]- , []- , [(CommentTok,"{- comment block start")]- , [(CommentTok," continues")]- , [(CommentTok," ends -}")]- ]- expected @=? lexed- , testCase "parse comment with newline" $ do- let example = unlines $ [ "-- first line"- , "--"- , "-- second line"- ]- let expected = [ [(CommentTok,"-- first line")]- , [(CommentTok,"--")]- , [(CommentTok,"-- second line")]- ]- expected @=? highlightCode "haskell" (toS example)- , testCase "parse comment with newline (indented)" $ do- let example = unlines $ [ " -- first line"- , " --"- , " -- second line"- ]- let expected = [ [(NormalTok," "),(NormalTok," "),(CommentTok,"-- first line")]- , [(NormalTok," "),(NormalTok," "),(CommentTok,"--")]- , [(NormalTok," "),(NormalTok," "),(CommentTok,"-- second line")]- ]- expected @=? highlightCode "haskell" (toS example)- , testCase "parse comment with newline (python)" $ do- let example = unlines $ [ "# first line"- , "#"- , "# second line"- ]- let expected = [ [(CommentTok,"# first line")]- , [(CommentTok,"#")]- , [(CommentTok,"# second line")]- ]- expected @=? highlightCode "python" (toS example)- ]- , testGroup "Parsing comments from tokens"- [ testCase "Parse Python example" $ do- let input = [ [(CommentTok,"# first comment")]- , []- , [(CommentTok,"# second comment")]- , [(CommentTok,"# is multi-line")]- , []- , [(DecValTok,"1"),(NormalTok," "),(OperatorTok,"+"),(NormalTok," "),(DecValTok,"2"),(NormalTok," "),(CommentTok,"# trailing comment")]- ]- let expected = [ newComment 0 "# first comment"- , newComment 2 "# second comment\n# is multi-line"- , newComment 5 "# trailing comment"+ let lexed = highlightCode python pythonExample+ let expected = [ comment "# first comment", eol+ , eol+ , comment "# second comment", eol+ , comment "# is multi-line", eol+ , eol+ , Token (Literal :. Number :. Integer) "1", text " ", Token Operator "+", text " ", Token (Literal :. Number :. Integer) "2", text " ", comment "# trailing comment", eol ]- expected @=? parseComments' input- , testCase "Parse indented example" $ do- let input = [ [(NormalTok," "),(NormalTok," "),(CommentTok,"-- second comment")]- , [(NormalTok," "),(NormalTok," "),(CommentTok,"-- is multi-line")]- ]- let expected = [ newComment 0 "-- second comment\n-- is multi-line" ]- expected @=? parseComments' input- , testCase "Commented blank line continues comment" $ do- let input = [ [(CommentTok,"# comment")]- , [(CommentTok,"#")]- , [(CommentTok,"# is multi-line")]- ]- let expected = [ newComment 0 "# comment\n#\n# is multi-line" ]- expected @=? parseComments' input+ expected `tokensEqual` lexed ] , testGroup "Parsing comments from source" [ testCase "Multi-line Haskell comment" $ do@@ -128,12 +49,19 @@ , "--" , "-- Conclusion" ]- let expected = [ newComment 0 (stripEnd example) ]- expected @=? parseComments "haskell" example+ let expected = [ newComment Nothing 0 (ByteString.init example) ]+ expected @=? parseComments Nothing haskell example ] ] -pythonExample :: Text++haskell :: Language+haskell = fromJust (lexerFromFilename "foo.hs")++python :: Language+python = fromJust (lexerFromFilename "foo.py")++pythonExample :: ByteString pythonExample = unlines $ [ "# first comment" , ""@@ -143,28 +71,27 @@ , "1 + 2 # trailing comment" ] -haskellExample :: Text-haskellExample = unlines $- [ "-- first comment"- , ""- , "-- second comment"- , "-- is multi-line"- , ""- , "{- comment block start"- , "continues"- , "ends -}"- , ""- , "f = {- foo -} \"bar\" {- baz -} -- qux"- ] -indentedHaskellExample :: Text-indentedHaskellExample = unlines $- [ "-- first comment"- , ""- , " -- second comment"- , " -- is multi-line"- , ""- , "{- comment block start"- , " continues"- , " ends -}"- ]+equalsBy :: (a -> a -> Bool) -> [a] -> [a] -> Bool+equalsBy _ [] [] = True+equalsBy _ _ [] = False+equalsBy _ [] _ = False+equalsBy p (x:xs) (y:ys) = p x y && equalsBy p xs ys++tokensEqual :: [Token] -> [Token] -> Assertion+tokensEqual xs ys =+ assertBool (ppShow xs <> " /= " <> ppShow ys) (equalsBy tokenEquals xs ys)+ where+ tokenEquals (Token xType xText) (Token yType yText) =+ (and [ shortName xType == shortName yType, xText == yText ])+++comment :: ByteString -> Token+comment = Token Comment++text :: ByteString -> Token+text = Token Text++eol :: Token+eol = Token Text "\n"+
tests/Diff.hs view
@@ -30,7 +30,7 @@ , "+ , comment" , "+ ) where" ]- let expected = [ newComment 0 "-- | Extract comments from diffs"]+ let expected = [ newComment (Just "src/Fixme/Diff.hs") 0 "-- | Extract comments from diffs"] Right expected @=? newCommentsFromDiff input , testCase "Multi-line comment" $ do let input = Data.ByteString.Char8.unlines $@@ -51,6 +51,6 @@ , "+ , comment" , "+ ) where" ]- let expected = [ newComment 0 "-- | Extract comments from diffs\n--\n-- Yep."]+ let expected = [ newComment (Just "src/Fixme/Diff.hs") 0 "-- | Extract comments from diffs\n--\n-- Yep."] Right expected @=? newCommentsFromDiff input ]
tests/Main.hs view
@@ -6,6 +6,7 @@ import qualified Comment import qualified Diff+import qualified Todo main :: IO ()@@ -14,6 +15,7 @@ tests :: TestTree tests = testGroup "Fixme"- [ Diff.tests- , Comment.tests+ [ Comment.tests+ , Diff.tests+ , Todo.tests ]
+ tests/Todo.hs view
@@ -0,0 +1,23 @@+module Todo (tests) where++import Protolude++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit++import Fixme.Comment (newComment)+import Fixme.Todo (getTodos)++tests :: TestTree+tests =+ testGroup "Fixme.Todo"+ [ testCase "No todos" $ do+ let comment = newComment (Just "somefile") 1 "# wolverhampton"+ let expected = []+ expected @=? getTodos comment+ , testCase "One todo" $ do+ let comment = newComment (Just "somefile") 1 "# TODO: wolverhampton"+ let expected = [ toS <$> comment ]+ let observed = getTodos comment+ expected @=? observed+ ]