packages feed

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
@@ -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+  ]