diff --git a/all-todos/Main.hs b/all-todos/Main.hs deleted file mode 100644 --- a/all-todos/Main.hs +++ /dev/null @@ -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) diff --git a/cmd/all-todos/Main.hs b/cmd/all-todos/Main.hs new file mode 100644 --- /dev/null +++ b/cmd/all-todos/Main.hs @@ -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) diff --git a/cmd/diff-todo/Main.hs b/cmd/diff-todo/Main.hs new file mode 100644 --- /dev/null +++ b/cmd/diff-todo/Main.hs @@ -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) diff --git a/cmd/git-todo/Main.hs b/cmd/git-todo/Main.hs new file mode 100644 --- /dev/null +++ b/cmd/git-todo/Main.hs @@ -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 ` 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) diff --git a/difftodo.cabal b/difftodo.cabal --- a/difftodo.cabal +++ b/difftodo.cabal @@ -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 diff --git a/src/Fixme.hs b/src/Fixme.hs --- a/src/Fixme.hs +++ b/src/Fixme.hs @@ -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 diff --git a/src/Fixme/Comment.hs b/src/Fixme/Comment.hs --- a/src/Fixme/Comment.hs +++ b/src/Fixme/Comment.hs @@ -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 diff --git a/src/Fixme/Diff.hs b/src/Fixme/Diff.hs --- a/src/Fixme/Diff.hs +++ b/src/Fixme/Diff.hs @@ -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. diff --git a/src/Fixme/Todo.hs b/src/Fixme/Todo.hs --- a/src/Fixme/Todo.hs +++ b/src/Fixme/Todo.hs @@ -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 "" identity (filename todo) + lineNum = show (startLine todo) + indentedComment = Text.unlines (map (" " <>) (Text.lines (todoText todo))) defaultTags :: [Text] defaultTags = [ "XXX" diff --git a/tests/Comment.hs b/tests/Comment.hs --- a/tests/Comment.hs +++ b/tests/Comment.hs @@ -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" + diff --git a/tests/Diff.hs b/tests/Diff.hs --- a/tests/Diff.hs +++ b/tests/Diff.hs @@ -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 ] diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -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 ] diff --git a/tests/Todo.hs b/tests/Todo.hs new file mode 100644 --- /dev/null +++ b/tests/Todo.hs @@ -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 + ]