diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -59,10 +59,12 @@
- C/C++
- C#
+- CSS/SASS
- Elixir
- Erlang
- Go
- Haskell
+- HTML
- Java
- Javascript
- Kotlin
@@ -129,21 +131,6 @@
# directory you are currently in:
$ docker run -it -v $(pwd):/repo -p 9001:9001 toodles
-```
-
-### Current Limitations
-
-Due to the parser's current simplicity, Toodles won't see TODO's in multiline
-initiated comment. For instance in javascript
-
-```javascript
-// TODO(#bug) this would be parsed
-
-/*
-
- TODO(#bug) this will _not_ be picked up by toodles
-
-*/
```
### Background
diff --git a/app/Config.hs b/app/Config.hs
deleted file mode 100644
--- a/app/Config.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators #-}
-
-module Config
- ( toodlesArgs
- , ToodlesArgs(..)
- , SearchFilter(..)
- , AssigneeFilterRegex(..)
- )
- where
-
-import Paths_toodles
-import Types
-
-import Data.Text (Text)
-import Data.Version (showVersion)
-import System.Console.CmdArgs
-
-toodlesArgs :: IO ToodlesArgs
-toodlesArgs = cmdArgs argParser
-
-data ToodlesArgs = ToodlesArgs
- { directory :: FilePath
- , assignee_search :: Maybe SearchFilter
- , limit_results :: Int
- , port :: Maybe Int
- , no_server :: Bool
- , userFlag :: [UserFlag]
- } deriving (Show, Data, Typeable, Eq)
-
-newtype SearchFilter =
- AssigneeFilter AssigneeFilterRegex
- deriving (Show, Data, Eq)
-
-newtype AssigneeFilterRegex = AssigneeFilterRegex Text
- deriving (Show, Data, Eq)
-
-argParser :: ToodlesArgs
-argParser = ToodlesArgs
- { directory = def &= typFile &= help "Root directory of your project"
- , assignee_search = def &= help "Filter todo's by assignee"
- , limit_results = def &= help "Limit number of search results"
- , port = def &= help "Run server on port"
- , no_server = def &= help "Output matching todos to the command line and exit"
- , userFlag = def &= help "Additional flagword (e.g.: MAYBE)"
- } &= summary ("toodles " ++ showVersion version)
- &= program "toodles"
- &= verbosity
- &= help "Manage TODO's directly from your codebase"
diff --git a/app/Main.hs b/app/Main.hs
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -27,7 +27,7 @@
run webPort $ app $ ToodlesState ref dataDir
prettyFormat :: TodoEntry -> String
-prettyFormat (TodoEntryHead _ l a p n entryPriority f _ _ _) =
+prettyFormat (TodoEntryHead _ l a p n entryPriority f _ _ _ _ _ _) =
printf
"Assignee: %s\n%s%s:%d\n%s - %s"
(fromMaybe "None" a)
@@ -36,4 +36,4 @@
n
(show f)
(unlines $ map T.unpack l)
-prettyFormat (TodoBodyLine _) = error "Invalid type for prettyFormat"
+prettyFormat a = error "Invalid type for prettyFormat: " ++ show a
diff --git a/app/Parse.hs b/app/Parse.hs
deleted file mode 100644
--- a/app/Parse.hs
+++ /dev/null
@@ -1,220 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Parse where
-
-import Types
-
-import Data.List (find)
-import Data.Maybe (fromJust, fromMaybe, isNothing)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Data.Void (Void)
-import Text.Megaparsec
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import Text.Read
-
-type Parser = Parsec Void Text
-
-symbol :: Text -> Parser Text
-symbol = L.symbol space
-
-parseComment :: Text -> Parser TodoEntry
-parseComment extension = do
- _ <- manyTill anyChar (symbol $ getCommentForFileType extension)
- b <- many anyChar
- return . TodoBodyLine $ T.pack b
-
-getCommentForFileType :: Text -> Text
-getCommentForFileType extension =
- fromMaybe unkownMarker $ lookup adjustedExtension fileTypeToComment
- where
- adjustedExtension =
- if T.isPrefixOf "." extension
- then extension
- else "." <> extension
-
-integer :: Parser Integer
-integer = lexeme $ L.signed space L.decimal
-
- where
- lexeme :: Parser a -> Parser a
- lexeme = L.lexeme space
-
-parseAssignee :: Parser String
-parseAssignee = many (noneOf [')', '|', '='])
-
--- TODO(avi|p=3|#cleanup) - fix and type this better
-parseDetails :: Text -> (Maybe Text, Maybe Text, [(Text, Text)], [Text])
-parseDetails toParse =
- let dataTokens = T.splitOn "|" toParse
- assigneeTo =
- find
- (\t ->
- not (T.null t) &&
- not (T.isInfixOf "=" t) && not (T.isPrefixOf "#" t))
- dataTokens
- allDetails =
- map (\[a, b] -> (a, b)) $ filter (\t -> length t == 2) $
- map (T.splitOn "=") dataTokens
- priorityVal = snd <$> find (\t -> T.strip (fst t) == "p") allDetails
- filteredDetails = filter (\t -> T.strip (fst t) /= "p") allDetails
- entryTags = filter (T.isPrefixOf "#") dataTokens
- in (assigneeTo, priorityVal, filteredDetails, entryTags)
-
--- | parse "hard-coded" flags, and user-defined flags if any
-parseFlag :: [UserFlag] -> Parser Flag
-parseFlag us = foldr (\a b -> b <|> foo a) (try parseFlagHardcoded) us
- where
- foo :: UserFlag -> Parser Flag
- foo (UserFlag x) = try (symbol x *> pure (UF $ UserFlag x))
-
--- | parse flags TODO, FIXME, XXX
-parseFlagHardcoded :: Parser Flag
-parseFlagHardcoded =
- try (symbol "TODO" *> pure TODO )
- <|> try (symbol "FIXME" *> pure FIXME)
- <|> (symbol "XXX" *> pure XXX )
-
-
-fileTypeToComment :: [(Text, Text)]
-fileTypeToComment =
- [ (".c", "//")
- , (".cc", "//")
- , (".clj", ";;")
- , (".cpp", "//")
- , (".cxx", "//")
- , (".c++", "//")
- , (".cs", "//")
- , (".ex", "#")
- , (".erl", "%")
- , (".go", "//")
- , (".h", "//")
- , (".hh", "//")
- , (".hpp", "//")
- , (".hs", "--")
- , (".hxx", "//")
- , (".h++", "//")
- , (".java", "//")
- , (".js", "//")
- , (".jsx", "//")
- , (".kt", "//")
- , (".kts", "//")
- , (".lua", "--")
- , (".m", "//")
- , (".php", "//")
- , (".proto", "//")
- , (".py", "#")
- , (".rb", "#")
- , (".rs", "//")
- , (".scala", "//")
- , (".sh", "#")
- , (".swift", "///")
- , (".ts", "//")
- , (".tsx", "//")
- , (".txt", "")
- , (".vue", "//")
- , (".yaml", "#")
- ]
-
-runTodoParser :: [UserFlag] -> SourceFile -> [TodoEntry]
-runTodoParser us (SourceFile path ls) =
- let parsedTodoLines =
- map
- (\(lineNum, lineText) -> parseMaybe (parseTodo us path lineNum) lineText)
- (zip [1 ..] ls)
- groupedTodos = foldl foldTodoHelper ([], False) parsedTodoLines
- in fst groupedTodos
-
- where
- -- fold fn to concatenate todos that a multiple, single line comments
- foldTodoHelper :: ([TodoEntry], Bool) -> Maybe TodoEntry -> ([TodoEntry], Bool)
- foldTodoHelper (todoEntries, currentlyBuildingTodoLines) maybeTodo
- -- We're not on a todo line, keep going
- | isNothing maybeTodo = (todoEntries, False)
- -- We see the start of a new todo
- | isEntryHead $ fromJust maybeTodo = (todoEntries ++ [fromJust maybeTodo], True)
- -- We a body line of a todo to concatenate to the current one
- | isBodyLine (fromJust maybeTodo) && currentlyBuildingTodoLines =
- (init todoEntries ++ [combineTodo (last todoEntries) (fromJust maybeTodo)], True)
- | otherwise = (todoEntries, False)
-
- where
- isEntryHead :: TodoEntry -> Bool
- isEntryHead TodoEntryHead {} = True
- isEntryHead _ = False
-
- isBodyLine :: TodoEntry -> Bool
- isBodyLine (TodoBodyLine _) = True
- isBodyLine _ = False
-
- combineTodo :: TodoEntry -> TodoEntry -> TodoEntry
- combineTodo (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText) (TodoBodyLine l) =
- TodoEntryHead i (b ++ [l]) a p n entryPriority f attrs entryTags entryLeadingText
- combineTodo _ _ = error "Can't combine todoEntry of these types"
-
-getExtension :: FilePath -> Text
-getExtension path = last $ T.splitOn "." (T.pack path)
-
-stringToMaybe :: Text -> Maybe Text
-stringToMaybe t =
- if T.null t
- then Nothing
- else Just t
-
-fst4 :: (a, b, c, d) -> a
-fst4 (x, _, _, _) = x
-
-snd4 :: (a, b, c, d) -> b
-snd4 (_, x, _, _) = x
-
-thd4 :: (a, b, c, d) -> c
-thd4 (_, _, x, _) = x
-
-fth4 :: (a, b, c, d) -> d
-fth4 (_, _, _, x) = x
-
-unkownMarker :: Text
-unkownMarker = "UNKNOWN-DELIMETER-UNKNOWN-DELIMETER-UNKNOWN-DELIMETER"
-
-parseTodo :: [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry
-parseTodo us path lineNum = try (parseTodoEntryHead us)
- <|> parseComment (getExtension path)
- where
- parseTodoEntryHead :: [UserFlag] -> Parser TodoEntry
- parseTodoEntryHead uf = do
- entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path)
- f <- parseFlag uf
- entryDetails <- optional $ try (inParens $ many (noneOf [')', '(']))
- let parsedDetails = parseDetails . T.pack <$> entryDetails
- entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails)
- otherDetails = maybe [] thd4 parsedDetails
- entryTags = maybe [] fth4 parsedDetails
- _ <- optional $ symbol "-"
- _ <- optional $ symbol ":"
- b <- many anyChar
- return $
- TodoEntryHead
- 0
- [T.pack b]
- (stringToMaybe . T.strip $ fromMaybe "" (fst4 =<< parsedDetails))
- path
- lineNum
- entryPriority
- f
- otherDetails
- entryTags
- (T.pack entryLeadingText)
-
- where
- inParens :: Parser a -> Parser a
- inParens = between (symbol "(") (symbol ")")
-
- prefixParserForFileType :: Text -> Parser Text
- prefixParserForFileType "org" = try (symbol "****")
- <|> try (symbol "***")
- <|> try (symbol "**")
- <|> try (symbol "*")
- <|> symbol "-"
- prefixParserForFileType extension = symbol . getCommentForFileType $ extension
diff --git a/app/Server.hs b/app/Server.hs
deleted file mode 100644
--- a/app/Server.hs
+++ /dev/null
@@ -1,292 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-{-# LANGUAGE TypeOperators #-}
-
-module Server where
-
-import Config
-import Parse
-import ToodlesApi
-import Types
-
-import qualified Control.Exception as E
-import Control.Monad
-import Control.Monad.IO.Class
-import Data.Aeson (FromJSON)
-import Data.Aeson.Types
-import Data.Either
-import Data.IORef
-import Data.List (find, nub)
-import Data.Maybe
-import Data.String.Utils
-import Data.Text (Text)
-import qualified Data.Text as T
-import qualified Data.Yaml as Y
-import Servant
-import System.Directory
-import System.IO.HVFS
-import qualified System.IO.Strict as SIO
-import System.Path
-import System.Path.NameManip
-import Text.Blaze.Html5 (Html)
-import qualified Text.Blaze.Html5 as BZ
-import Text.Printf
-import Text.Regex.Posix
-
-data ToodlesConfig = ToodlesConfig
- { ignore :: [FilePath]
- , flags :: [UserFlag]
- } deriving (Show)
-
-instance FromJSON ToodlesConfig where
- parseJSON (Object o) = do
- parsedIgnore <- o .:? "ignore" .!= []
- parsedFlags <- o .:? "flags" .!= []
- return $ ToodlesConfig parsedIgnore parsedFlags
- parseJSON invalid = typeMismatch "Invalid config" invalid
-
-app :: ToodlesState -> Application
-app s = serve toodlesAPI server
-
- where
- server :: Server ToodlesAPI
- server = liftIO . getFullSearchResults s
- :<|> deleteTodos s
- :<|> editTodos s
- :<|> serveDirectoryFileServer (dataPath s)
- :<|> showRawFile s
- :<|> root s
-
-root :: ToodlesState -> [Text] -> Handler Html
-root (ToodlesState _ dPath) path =
- if null path then
- liftIO $ BZ.preEscapedToHtml <$> readFile (dPath ++ "/html/index.html")
- else throwError $ err404 { errBody = "Not found" }
-
-showRawFile :: ToodlesState -> Integer -> Handler Html
-showRawFile (ToodlesState ref _) eId = do
- (TodoListResult r _) <- liftIO $ readIORef ref
- let entry = find (\t -> entryId t == eId) r
- liftIO $
- maybe
- (return "Not found")
- (\e -> addAnchors <$> readFile (sourceFile e))
- entry
-
- where
- addAnchors :: String -> Html
- addAnchors s =
- let codeLines = zip [1::Int ..] $ lines s
- in BZ.preEscapedToHtml $
- (unlines $
- map
- (\(i, l) -> printf "%s
" (show i) l)
- codeLines)
-
-editTodos :: ToodlesState -> EditTodoRequest -> Handler Text
-editTodos (ToodlesState ref _) req = do
- (TodoListResult r _) <- liftIO $ readIORef ref
- let editedList = map
- (\t ->
- if willEditTodo req t
- then editTodo req t
- else t)
- r
- editedFilteredList = filter (willEditTodo req) editedList
- _ <- mapM_ recordUpdates editedFilteredList
- return "{}"
- where
- willEditTodo :: EditTodoRequest -> TodoEntry -> Bool
- willEditTodo editRequest entry = entryId entry `elem` editIds editRequest
-
- editTodo :: EditTodoRequest -> TodoEntry -> TodoEntry
- editTodo editRequest entry =
- let newAssignee = if isJust (setAssignee editRequest) && (not . T.null . fromJust $ setAssignee editRequest)
- then setAssignee editRequest
- else assignee entry
- newPriority = if isJust (setPriority editRequest) then setPriority editRequest else priority entry in
-
- entry {assignee = newAssignee,
- tags = tags entry ++ addTags editRequest,
- priority = newPriority,
- customAttributes = nub $ customAttributes entry ++ addKeyVals editRequest}
-
- recordUpdates :: MonadIO m => TodoEntry -> m ()
- recordUpdates t = void $ updateTodoLinesInFile renderTodo t
-
-renderTodo :: TodoEntry -> [Text]
-renderTodo t =
- let comment =
- fromJust $ lookup ("." <> getExtension (sourceFile t)) fileTypeToComment
- detail =
- renderFlag (flag t) <> " (" <>
- (T.pack $
- Data.String.Utils.join
- "|"
- (map T.unpack $ [fromMaybe "" $ assignee t] ++
- listIfNotNull (fmap (T.pack . maybe "" ((\n -> "p=" ++ n) . show)) priority t) ++
- tags t ++
- map (\a -> fst a <> "=" <> snd a) (customAttributes t))) <>
- ") "
- fullNoComments = mapHead (\l -> detail <> "- " <> l) $ body t
- commented = map (\l -> comment <> " " <> l) fullNoComments in
- mapHead (\l -> leadingText t <> l) $
- mapInit (\l -> foldl (<>) "" [" " | _ <- [1..(T.length $ leadingText t)]] <> l) commented
-
- where
- mapHead :: (a -> a) -> [a] -> [a]
- mapHead f (x:xs) = f x : xs
- mapHead _ xs = xs
-
- mapInit :: (a -> a) -> [a] -> [a]
- mapInit f (x:xs) = [x] ++ map f xs
- mapInit _ x = x
-
- listIfNotNull :: Text -> [Text]
- listIfNotNull "" = []
- listIfNotNull s = [s]
-
- renderFlag :: Flag -> Text
- renderFlag TODO = "TODO"
- renderFlag FIXME = "FIXME"
- renderFlag XXX = "XXX"
- renderFlag (UF (UserFlag x)) = x
-
--- | Given a function to emit new lines for a given todo, write that update in
--- place of the current todo lines
-updateTodoLinesInFile :: MonadIO m => (TodoEntry -> [Text]) -> TodoEntry -> m ()
-updateTodoLinesInFile f todo = do
- let startIndex = lineNumber todo - 1
- newLines = map T.unpack $ f todo
- fileLines <- liftIO $ lines <$> SIO.readFile (sourceFile todo)
- let updatedLines =
- slice 0 (fromIntegral $ startIndex - 1) fileLines ++ newLines ++
- (slice
- (fromIntegral startIndex + length (body todo))
- (length fileLines - 1)
- fileLines)
- liftIO $ writeFile (sourceFile todo) $ unlines updatedLines
-
- where
- slice :: Int -> Int -> [a] -> [a]
- slice a b xs = take (b - a + 1) (drop a xs)
-
-deleteTodos :: ToodlesState -> DeleteTodoRequest -> Handler Text
-deleteTodos (ToodlesState ref _) req = do
- refVal@(TodoListResult r _) <- liftIO $ readIORef ref
- let toDelete = filter (\t -> entryId t `elem` ids req) r
- liftIO $ doUntilNull removeAndAdjust toDelete
- let remainingResults = filter (\t -> entryId t `notElem` map entryId toDelete) r
- updatedResults <- return $ foldl (flip adjustLinesAfterDeletionOf) remainingResults toDelete
- let remainingResultsRef = refVal { todos = updatedResults }
- _ <- liftIO $ atomicModifyIORef' ref (const (remainingResultsRef, remainingResultsRef))
- return "{}"
-
- where
-
- doUntilNull :: ([a] -> IO [a]) -> [a] -> IO ()
- doUntilNull f xs = do
- result <- f xs
- if null result
- then return ()
- else doUntilNull f result
-
- -- If we delete an entry, we need to decrement the line-numbers for the
- -- other entries that come later in the file
- adjustLinesAfterDeletionOf :: TodoEntry -> [TodoEntry] -> [TodoEntry]
- adjustLinesAfterDeletionOf deleted =
- map (\remaining ->
- if (sourceFile remaining == sourceFile deleted) && (lineNumber remaining > lineNumber deleted)
- then remaining { lineNumber = lineNumber remaining - (fromIntegral . length $ body deleted)}
- else remaining)
-
- removeAndAdjust :: MonadIO m => [TodoEntry] -> m [TodoEntry]
- removeAndAdjust [] = return []
- removeAndAdjust (x:xs) = do
- removeTodoFromCode x
- return $ adjustLinesAfterDeletionOf x xs
-
- where
- removeTodoFromCode :: MonadIO m => TodoEntry -> m ()
- removeTodoFromCode = updateTodoLinesInFile (const [])
-
-setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs
-setAbsolutePath args = do
- let pathOrDefault = if T.null . T.pack $ directory args
- then "."
- else directory args
- absolute <- normalise_path <$> absolute_path pathOrDefault
- return $ args {directory = absolute}
-
-getFullSearchResults :: ToodlesState -> Bool -> IO TodoListResult
-getFullSearchResults (ToodlesState ref _) recompute =
- if recompute
- then do
- putStrLn "refreshing todo's"
- userArgs <- toodlesArgs >>= setAbsolutePath
- sResults <- runFullSearch userArgs
- atomicModifyIORef' ref (const (sResults, sResults))
- else putStrLn "cached read" >> readIORef ref
-
-runFullSearch :: ToodlesArgs -> IO TodoListResult
-runFullSearch userArgs = do
- let projectRoot = directory userArgs
- configExists <- doesFileExist $ projectRoot ++ "/.toodles.yaml"
- config <- if configExists
- then Y.decodeFileEither (projectRoot ++ "/.toodles.yaml")
- else return . Right $ ToodlesConfig [] []
- when (isLeft config)
- $ putStrLn $ "[WARNING] Invalid .toodles.yaml: " ++ show config
- let config' = fromRight (ToodlesConfig [] []) config
- allFiles <- getAllFiles config' projectRoot
- let parsedTodos = concatMap (runTodoParser $ userFlag userArgs ++ flags config') allFiles
- filteredTodos = filter (filterSearch (assignee_search userArgs)) parsedTodos
- resultList = limitSearch filteredTodos $ limit_results userArgs
- indexedResults = map (\(i, r) -> r {entryId = i}) $ zip [1 ..] resultList
- return $ TodoListResult indexedResults ""
-
- where
- filterSearch :: Maybe SearchFilter -> TodoEntry -> Bool
- filterSearch Nothing _ = True
- filterSearch (Just (AssigneeFilter (AssigneeFilterRegex query))) entry = fromMaybe "" (assignee entry) == query
-
- limitSearch :: [TodoEntry] -> Int -> [TodoEntry]
- limitSearch todoList 0 = todoList
- limitSearch todoList n = take n todoList
-
-getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile]
-getAllFiles (ToodlesConfig ignoredPaths _) basePath =
- E.catch
- (do putStrLn $ printf "Running toodles for path: %s" basePath
- files <- recurseDir SystemFS basePath
- let validFiles = filter isValidFile files
- mapM
- (\f ->
- SourceFile f . (map T.pack . lines) <$>
- E.catch
- (SIO.readFile f)
- (\(e :: E.IOException) -> print e >> return ""))
- validFiles)
- (\(e :: E.IOException) ->
- putStrLn ("Error reading " ++ basePath ++ ": " ++ show e) >> return [])
-
- where
-
- isValidFile :: FilePath -> Bool
- isValidFile path = fileHasValidExtension && not ignoreFile
-
- where
-
- fileHasValidExtension :: Bool
- fileHasValidExtension = any (\ext -> ext `T.isSuffixOf` T.pack path) (map fst fileTypeToComment)
-
- ignoreFile :: Bool
- ignoreFile =
- let p = T.pack path
- in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p ||
- T.isSuffixOf "_pb2.py" p ||
- any (\r -> path =~ r :: Bool) ignoredPaths
diff --git a/app/ToodlesApi.hs b/app/ToodlesApi.hs
deleted file mode 100644
--- a/app/ToodlesApi.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE DataKinds,
- ScopedTypeVariables,
- TypeOperators #-}
-
-module ToodlesApi where
-
-import Types
-
-import Data.Proxy (Proxy)
-import Data.Text (Text)
-import Servant
-import Servant.HTML.Blaze (HTML)
-import Text.Blaze.Html5 (Html)
-
-type ToodlesAPI = "todos" :> QueryFlag "recompute" :> Get '[JSON] TodoListResult
-
- :<|> "todos" :> "delete" :> ReqBody '[JSON] DeleteTodoRequest :> Post '[JSON] Text
-
- :<|> "todos" :> "edit" :> ReqBody '[JSON] EditTodoRequest :> Post '[JSON] Text
-
- :<|> "static" :> Raw
-
- :<|> "source_file" :> Capture "id" Integer :> Get '[HTML] Html
-
- :<|> CaptureAll "anything-else" Text :> Get '[HTML] Html
-
-toodlesAPI :: Proxy ToodlesAPI
-toodlesAPI = Proxy
diff --git a/app/Types.hs b/app/Types.hs
deleted file mode 100644
--- a/app/Types.hs
+++ /dev/null
@@ -1,97 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Types where
-
-import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON,
- toJSON)
-import Data.Aeson.Types (typeMismatch)
-import Data.Data
-import Data.IORef (IORef)
-import Data.String (IsString)
-import Data.Text (Text)
-import qualified Data.Text as T (unpack)
-import GHC.Generics (Generic)
-
-data SourceFile = SourceFile
- { fullPath :: FilePath
- , sourceLines :: [Text]
- } deriving (Show)
-
-type LineNumber = Integer
-
-data ToodlesState = ToodlesState
- { results :: IORef TodoListResult,
- dataPath :: FilePath
- }
-
-data TodoEntry
- = TodoEntryHead { entryId :: Integer
- , body :: [Text]
- , assignee :: Maybe Text
- , sourceFile :: FilePath
- , lineNumber :: LineNumber
- , priority :: Maybe Integer
- , flag :: Flag
- , customAttributes :: [(Text, Text)]
- , tags :: [Text]
- , leadingText :: Text }
- | TodoBodyLine Text
- deriving (Show, Generic)
-instance ToJSON TodoEntry
-
-data TodoListResult = TodoListResult
- { todos :: [TodoEntry]
- , message :: Text
- } deriving (Show, Generic)
-instance ToJSON TodoListResult
-
-newtype DeleteTodoRequest = DeleteTodoRequest
- { ids :: [Integer]
- } deriving (Show, Generic)
-instance FromJSON DeleteTodoRequest
-
-data EditTodoRequest = EditTodoRequest
- { editIds :: [Integer]
- , setAssignee :: Maybe Text
- , addTags :: [Text]
- , addKeyVals :: [(Text, Text)]
- , setPriority :: Maybe Integer
- } deriving (Show, Generic)
-instance FromJSON EditTodoRequest
-
-data Flag = TODO | FIXME | XXX | UF UserFlag
- deriving (Generic)
-
-newtype UserFlag = UserFlag Text
- deriving (Show, Eq, IsString, Data, Generic)
-
-instance Show Flag where
- show TODO = "TODO"
- show FIXME = "FIXME"
- show XXX = "XXX"
- show (UF (UserFlag x)) = T.unpack x
-
-instance ToJSON Flag where
- toJSON TODO = Data.Aeson.String "TODO"
- toJSON FIXME = Data.Aeson.String "FIXME"
- toJSON XXX = Data.Aeson.String "XXX"
- toJSON (UF (UserFlag x)) = Data.Aeson.String x
-
-instance FromJSON Flag where
- parseJSON (Data.Aeson.String x) =
- case x of
- "TODO" -> pure TODO
- "FIXME" -> pure FIXME
- "XXX" -> pure XXX
- _ -> pure $ UF $ UserFlag x
- parseJSON invalid = typeMismatch "UserFlag" invalid
-
-instance ToJSON UserFlag where
- toJSON (UserFlag x) = Data.Aeson.String x
-
-instance FromJSON UserFlag where
- parseJSON (Data.Aeson.String x) = pure $ UserFlag x
- parseJSON invalid = typeMismatch "UserFlag" invalid
diff --git a/src/Config.hs b/src/Config.hs
new file mode 100644
--- /dev/null
+++ b/src/Config.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Config
+ ( toodlesArgs
+ , ToodlesArgs(..)
+ , SearchFilter(..)
+ , AssigneeFilterRegex(..)
+ )
+ where
+
+import Paths_toodles
+import Types
+
+import Data.Text (Text)
+import Data.Version (showVersion)
+import System.Console.CmdArgs
+
+toodlesArgs :: IO ToodlesArgs
+toodlesArgs = cmdArgs argParser
+
+data ToodlesArgs = ToodlesArgs
+ { directory :: FilePath
+ , assignee_search :: Maybe SearchFilter
+ , limit_results :: Int
+ , port :: Maybe Int
+ , no_server :: Bool
+ , userFlag :: [UserFlag]
+ } deriving (Show, Data, Typeable, Eq)
+
+newtype SearchFilter =
+ AssigneeFilter AssigneeFilterRegex
+ deriving (Show, Data, Eq)
+
+newtype AssigneeFilterRegex = AssigneeFilterRegex Text
+ deriving (Show, Data, Eq)
+
+argParser :: ToodlesArgs
+argParser = ToodlesArgs
+ { directory = def &= typFile &= help "Root directory of your project"
+ , assignee_search = def &= help "Filter todo's by assignee"
+ , limit_results = def &= help "Limit number of search results"
+ , port = def &= help "Run server on port"
+ , no_server = def &= help "Output matching todos to the command line and exit"
+ , userFlag = def &= help "Additional flagword (e.g.: MAYBE)"
+ } &= summary ("toodles " ++ showVersion version)
+ &= program "toodles"
+ &= verbosity
+ &= help "Manage TODO's directly from your codebase"
diff --git a/src/Parse.hs b/src/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Parse.hs
@@ -0,0 +1,368 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Parse where
+
+import Types
+
+
+import Data.Functor
+import Data.List (find)
+import Data.Maybe (fromJust, fromMaybe, isJust,
+ isNothing)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+import Text.Printf
+import Text.Read
+
+type Parser = Parsec Void Text
+
+symbol :: Text -> Parser Text
+symbol = L.symbol space
+
+parseComment :: TodoParserState -> Text -> Parser TodoEntry
+parseComment state fileExtension =
+ if state == ParseStateMultiLineComment
+ then do
+ let closingParser = symbol $ getMultiClosingForFileType fileExtension
+ lineWithClosing <- optional . try $ manyTill anyChar closingParser
+ lineWithOutClosing <- optional $ many anyChar
+ return $ TodoBodyLine (T.pack (fromMaybe (fromJust lineWithOutClosing) lineWithOutClosing)) False (isJust lineWithClosing)
+ else do
+ single <- optional . try $ manyTill anyChar (symbol $ getCommentForFileType fileExtension)
+ multi <-
+ if isJust single
+ then return Nothing
+ else
+ optional . try $ manyTill anyChar (symbol $ getMultiOpeningForFileType fileExtension)
+ if isJust single || isJust multi
+ then do
+ b <- many anyChar
+ return $ TodoBodyLine (T.pack b) (isJust multi) (getMultiClosingForFileType fileExtension `T.isInfixOf` T.pack b)
+ else
+ fail "No open comment marker found"
+
+getCommentForFileType :: Text -> Text
+getCommentForFileType fileExtension =
+ getCommentForFileTypeWithDefault singleCommentStart fileExtension
+
+getMultiClosingForFileType :: Text -> Text
+getMultiClosingForFileType fileExtension =
+ getCommentForFileTypeWithDefault multiLineClose fileExtension
+
+getMultiOpeningForFileType :: Text -> Text
+getMultiOpeningForFileType fileExtension =
+ getCommentForFileTypeWithDefault multiLineOpen fileExtension
+
+getCommentForFileTypeWithDefault :: (FileTypeDetails -> Maybe Text) -> Text -> Text
+getCommentForFileTypeWithDefault getter fileExtension =
+ fromMaybe unkownMarker (getter =<< find (\a -> extension a == adjustedExtension) fileTypeToComment)
+ where
+ adjustedExtension =
+ if T.isPrefixOf "." fileExtension
+ then fileExtension
+ else "." <> fileExtension
+
+integer :: Parser Integer
+integer = lexeme $ L.signed space L.decimal
+
+ where
+ lexeme :: Parser a -> Parser a
+ lexeme = L.lexeme space
+
+parseAssignee :: Parser String
+parseAssignee = many (noneOf [')', '|', '='])
+
+-- TODO(avi|p=3|#cleanup) - fix and type this better
+parseDetails :: Text -> (Maybe Text, Maybe Text, [(Text, Text)], [Text])
+parseDetails toParse =
+ let dataTokens = T.splitOn "|" toParse
+ assigneeTo =
+ find
+ (\t ->
+ not (T.null t) &&
+ not (T.isInfixOf "=" t) && not (T.isPrefixOf "#" t))
+ dataTokens
+ allDetails =
+ map (\[a, b] -> (a, b)) $ filter (\t -> length t == 2) $
+ map (T.splitOn "=") dataTokens
+ priorityVal = snd <$> find (\t -> T.strip (fst t) == "p") allDetails
+ filteredDetails = filter (\t -> T.strip (fst t) /= "p") allDetails
+ entryTags = filter (T.isPrefixOf "#") dataTokens
+ in (assigneeTo, priorityVal, filteredDetails, entryTags)
+
+-- | parse "hard-coded" flags, and user-defined flags if any
+parseFlag :: [UserFlag] -> Parser Flag
+parseFlag = foldr (\a b -> b <|> foo a) (try parseFlagHardcoded)
+ where
+ foo :: UserFlag -> Parser Flag
+ foo (UserFlag x) = try (symbol x $> (UF $ UserFlag x))
+
+-- | parse flags TODO, FIXME, XXX
+parseFlagHardcoded :: Parser Flag
+parseFlagHardcoded =
+ try (symbol "TODO" $> TODO )
+ <|> try (symbol "FIXME" $> FIXME)
+ <|> (symbol "XXX" $> XXX )
+
+newtype MultineCommentEnclosing = MultineCommentEnclosing (Text, Text)
+
+data FileTypeDetails = FileTypeDetails
+ { extension :: Text
+ , singleCommentStart :: Maybe Text
+ , multilineEnclosing :: Maybe MultineCommentEnclosing
+ }
+
+multiLineClose :: FileTypeDetails -> Maybe Text
+multiLineClose (FileTypeDetails _ _ (Just (MultineCommentEnclosing (_, b)))) = Just b
+multiLineClose _ = Nothing
+
+multiLineOpen :: FileTypeDetails -> Maybe Text
+multiLineOpen (FileTypeDetails _ _ (Just (MultineCommentEnclosing (a, _)))) = Just a
+multiLineOpen _ = Nothing
+
+enclosing :: (Text, Text) -> Maybe MultineCommentEnclosing
+enclosing = Just . MultineCommentEnclosing
+
+slashStar :: Maybe MultineCommentEnclosing
+slashStar = enclosing ("/*", "*/")
+
+fileTypeToComment :: [FileTypeDetails]
+fileTypeToComment =
+ [ FileTypeDetails ".c" (Just "//") slashStar
+ , FileTypeDetails ".cc" (Just "//") slashStar
+ , FileTypeDetails ".clj" (Just ";;") Nothing
+ , FileTypeDetails ".cpp" (Just "//") slashStar
+ , FileTypeDetails ".cxx" (Just "//") slashStar
+ , FileTypeDetails ".c++" (Just "//") slashStar
+ , FileTypeDetails ".cs" (Just "//") slashStar
+ , FileTypeDetails ".css" Nothing slashStar
+ , FileTypeDetails ".ex" (Just "#") Nothing
+ , FileTypeDetails ".erl" (Just "%") Nothing
+ , FileTypeDetails ".go" (Just "//") slashStar
+ , FileTypeDetails ".h" (Just "//") slashStar
+ , FileTypeDetails ".hh" (Just "//") slashStar
+ , FileTypeDetails ".hpp" (Just "//") slashStar
+ , FileTypeDetails ".hs" (Just "--") (enclosing ("{-", "-}"))
+ , FileTypeDetails ".html" Nothing (enclosing (""))
+ , FileTypeDetails ".hxx" (Just "//") slashStar
+ , FileTypeDetails ".h++" (Just "//") slashStar
+ , FileTypeDetails ".java" (Just "//") slashStar
+ , FileTypeDetails ".js" (Just "//") slashStar
+ , FileTypeDetails ".jsx" (Just "//") slashStar
+ , FileTypeDetails ".kt" (Just "//") slashStar
+ , FileTypeDetails ".kts" (Just "//") slashStar
+ , FileTypeDetails ".lua" (Just "--") (enclosing ("--[[", "]]"))
+ , FileTypeDetails ".m" (Just "//") slashStar
+ , FileTypeDetails ".php" (Just "//") slashStar
+ , FileTypeDetails ".proto" (Just "//") slashStar
+ , FileTypeDetails ".py" (Just "#") (enclosing ("\"\"\"", "\"\"\""))
+ , FileTypeDetails ".rb" (Just "#") (enclosing ("=begin", "=end"))
+ , FileTypeDetails ".rs" (Just "//") slashStar
+ , FileTypeDetails ".scss" Nothing slashStar
+ , FileTypeDetails ".scala" (Just "//") slashStar
+ , FileTypeDetails ".sh" (Just "#") slashStar
+ , FileTypeDetails ".swift" (Just "///") slashStar
+ , FileTypeDetails ".ts" (Just "//") slashStar
+ , FileTypeDetails ".tsx" (Just "//") slashStar
+ , FileTypeDetails ".txt" (Just "") Nothing
+ , FileTypeDetails ".vue" (Just "//") slashStar
+ , FileTypeDetails ".yaml" (Just "#") Nothing
+ ]
+
+singleLineCommentForExtension :: Text -> Maybe Text
+singleLineCommentForExtension fileExtension =
+ find (\f -> extension f == fileExtension) fileTypeToComment >>= singleCommentStart
+
+multiLineOpenCommentForExtension :: Text -> Maybe Text
+multiLineOpenCommentForExtension fileExtension =
+ find (\f -> extension f == fileExtension) fileTypeToComment >>=
+ multilineEnclosing >>=
+ (\(MultineCommentEnclosing a) -> return $ fst a)
+
+-- Higher order function returning our folder.
+fileParseFoldFn ::
+ -- partial fn params
+ [UserFlag]
+ -> FilePath
+ -- returns a fold function of:
+ -> (TodoParserState, [Maybe TodoEntry])
+ -> (Integer, Text)
+ -> (TodoParserState, [Maybe TodoEntry])
+fileParseFoldFn userFlags file (currentLineState, pastList) (lineNum, line) =
+ let parsedLine = parseMaybe (parseTodo currentLineState userFlags file lineNum) line
+ newState = nextState currentLineState parsedLine in
+ (newState, pastList ++ [parsedLine])
+
+nextState :: TodoParserState -> Maybe TodoEntry -> TodoParserState
+nextState _ Nothing = ParseStateUnknown
+nextState _ (Just (TodoBodyLine _ _ True)) = ParseStateUnknown
+nextState _ (Just (TodoBodyLine _ True False)) = ParseStateMultiLineComment
+nextState s (Just (TodoBodyLine _ False False)) = s
+nextState _ (Just (TodoEntryHead _ _ _ _ _ _ _ _ _ _ _ True False)) = ParseStateMultiLineComment
+nextState _ (Just (TodoEntryHead _ _ _ _ _ _ _ _ _ _ MultiLine _ False)) = ParseStateMultiLineComment
+nextState _ (Just TodoEntryHead {}) = ParseStateUnknown
+nextState a b = error ("No next state for " ++ show a ++ " " ++ show b)
+
+runTodoParser :: [UserFlag] -> SourceFile -> [TodoEntry]
+runTodoParser us (SourceFile path ls) =
+ let parsedTodoLines =
+ foldl
+ (fileParseFoldFn
+ us
+ path)
+ (ParseStateUnknown, [])
+ (zip [1 ..] ls)
+ groupedTodos = foldl foldTodoHelper ([], False) (snd parsedTodoLines)
+ in fst groupedTodos
+
+ where
+ -- fold fn to concatenate todos that a multiple, single line comments
+ foldTodoHelper :: ([TodoEntry], Bool) -> Maybe TodoEntry -> ([TodoEntry], Bool)
+ foldTodoHelper (todoEntries, currentlyBuildingTodoLines) maybeTodo
+ -- We're not on a todo line, keep going
+ | isNothing maybeTodo = (todoEntries, False)
+ -- We see the start of a new todo
+ | isEntryHead $ fromJust maybeTodo = (todoEntries ++ [fromJust maybeTodo], True)
+ -- We a body line of a todo to concatenate to the current one
+ | isBodyLine (fromJust maybeTodo) && currentlyBuildingTodoLines =
+ (init todoEntries ++ [combineTodo (last todoEntries) (fromJust maybeTodo)], True)
+ | otherwise = (todoEntries, False)
+
+ where
+ isEntryHead :: TodoEntry -> Bool
+ isEntryHead TodoEntryHead {} = True
+ isEntryHead _ = False
+
+ isBodyLine :: TodoEntry -> Bool
+ isBodyLine TodoBodyLine {} = True
+ isBodyLine _ = False
+
+ combineTodo :: TodoEntry -> TodoEntry -> TodoEntry
+ combineTodo (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t isOpened _) (TodoBodyLine l _ isClosed) =
+ TodoEntryHead i (b ++ [l]) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
+ combineTodo (TodoBodyLine l isOpened _) (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t _ isClosed) =
+ TodoEntryHead i (l : b) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
+ combineTodo (TodoBodyLine l isOpened _) (TodoBodyLine r _ isClosed) =
+ TodoBodyLineCombined (l : [r]) isOpened isClosed
+ combineTodo (TodoBodyLineCombined l isOpened _) (TodoBodyLine r _ isClosed) =
+ TodoBodyLineCombined (l ++ [r]) isOpened isClosed
+ combineTodo (TodoBodyLineCombined l isOpened _) (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t _ isClosed) =
+ TodoEntryHead i (l ++ b) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
+ combineTodo _ _ = error "Can't combine todoEntry of these types"
+
+getExtension :: FilePath -> Text
+getExtension path = last $ T.splitOn "." (T.pack path)
+
+stringToMaybe :: Text -> Maybe Text
+stringToMaybe t =
+ if T.null t
+ then Nothing
+ else Just t
+
+fst4 :: (a, b, c, d) -> a
+fst4 (x, _, _, _) = x
+
+snd4 :: (a, b, c, d) -> b
+snd4 (_, x, _, _) = x
+
+thd4 :: (a, b, c, d) -> c
+thd4 (_, _, x, _) = x
+
+fth4 :: (a, b, c, d) -> d
+fth4 (_, _, _, x) = x
+
+unkownMarker :: Text
+unkownMarker = "UNKNOWN-DELIMETER-UNKNOWN-DELIMETER-UNKNOWN-DELIMETER"
+
+data TodoParserState
+ = ParseStateUnknown
+ | ParseStateSource
+ | ParseStateSingleComment
+ | ParseStateMultiLineComment deriving (Eq, Show)
+
+data LeadingTextKind = SingleLT | MultiLT | NonOpenedComment deriving (Eq, Show)
+
+takeShorter :: String -> String -> String
+takeShorter singleLeadingText multiLeadingText
+ | length singleLeadingText == length multiLeadingText = ""
+ | null singleLeadingText = multiLeadingText
+ | null multiLeadingText = singleLeadingText
+ | length singleLeadingText > length multiLeadingText = multiLeadingText
+ | length singleLeadingText < length multiLeadingText = singleLeadingText
+ | otherwise = ""
+
+parseTodo :: TodoParserState -> [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry
+parseTodo state us path lineNum = try (parseTodoEntryHead us)
+ <|> parseComment state (getExtension path)
+ where
+ parseTodoEntryHead :: [UserFlag] -> Parser TodoEntry
+ parseTodoEntryHead uf =
+ if state == ParseStateMultiLineComment
+ then do
+ leadingTextMulti <- optional (try $ many spaceChar)
+ parseEntryHead NonOpenedComment (fromMaybe "" leadingTextMulti)
+ else do
+ entryLeadingTextSingle <- optional (try (manyTill anyChar (lookAhead . prefixParserForFileType $ getExtension path)))
+ entryLeadingTextMulti <-
+ if isNothing entryLeadingTextSingle
+ then
+ optional (manyTill anyChar (lookAhead . multiPrefixParserForFileType $ getExtension path))
+ else
+ return Nothing
+
+ commentOpenSingle <- optional . try $ prefixParserForFileType $ getExtension path
+ commentOpenMulti <- optional . try $ multiPrefixParserForFileType $ getExtension path
+ let leadingTextKind = case (commentOpenSingle, commentOpenMulti) of
+ (Just _, Nothing) -> SingleLT
+ (Nothing, Just _) -> MultiLT
+ (Nothing, Nothing) -> NonOpenedComment
+ err -> error . printf "Error: unexpected value in leading text pattern match: %s. Please report this bug https://github.com/aviaviavi/toodles" $ show err
+
+ -- select the shorter leading text, and update leadingTextKind enum accordingly
+ matchingLeadingText = takeShorter (fromMaybe "" entryLeadingTextSingle) (fromMaybe "" entryLeadingTextMulti)
+
+ parseEntryHead leadingTextKind matchingLeadingText
+
+ where
+
+ parseEntryHead leadingTextCharsKind leadingTextChars = do
+ f <- parseFlag uf
+ entryDetails <- optional $ try (inParens $ many (noneOf [')', '(']))
+ let parsedDetails = parseDetails . T.pack <$> entryDetails
+ entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails)
+ otherDetails = maybe [] thd4 parsedDetails
+ entryTags = maybe [] fth4 parsedDetails
+ _ <- optional $ symbol "-"
+ _ <- optional $ symbol ":"
+ let closingParser = symbol $ getMultiClosingForFileType (getExtension path)
+ lineWithClosing <- optional . try $ manyTill anyChar closingParser
+ lineWithOutClosing <- optional $ many anyChar
+ return $
+ TodoEntryHead
+ 0
+ [T.pack (fromMaybe (fromJust lineWithOutClosing) lineWithClosing)]
+ (stringToMaybe . T.strip $ fromMaybe "" (fst4 =<< parsedDetails))
+ path
+ lineNum
+ entryPriority
+ f
+ otherDetails
+ entryTags
+ (T.pack leadingTextChars)
+ (if leadingTextCharsKind == SingleLT then SingleLine else MultiLine)
+ (leadingTextCharsKind == MultiLT)
+ (isJust lineWithClosing)
+
+ inParens :: Parser a -> Parser a
+ inParens = between (symbol "(") (symbol ")")
+
+ prefixParserForFileType :: Text -> Parser Text
+ prefixParserForFileType fileExtension = symbol . getCommentForFileType $ fileExtension
+
+ multiPrefixParserForFileType :: Text -> Parser Text
+ multiPrefixParserForFileType fileExtension = symbol . getMultiOpeningForFileType $ fileExtension
diff --git a/src/Server.hs b/src/Server.hs
new file mode 100644
--- /dev/null
+++ b/src/Server.hs
@@ -0,0 +1,321 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+{-# LANGUAGE TypeOperators #-}
+
+module Server where
+
+import Config
+import Parse
+import ToodlesApi
+import Types
+
+import qualified Control.Exception as E
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.Aeson (FromJSON)
+import Data.Aeson.Types
+import Data.Either
+import Data.IORef
+import Data.List (find, nub)
+import Data.Maybe
+import Data.String.Utils
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Yaml as Y
+import Servant
+import System.Directory
+import System.IO.HVFS
+import qualified System.IO.Strict as SIO
+import System.Path
+import System.Path.NameManip
+import Text.Blaze.Html5 (Html)
+import qualified Text.Blaze.Html5 as BZ
+import Text.Printf
+import Text.Regex.Posix
+
+data ToodlesConfig = ToodlesConfig
+ { ignore :: [FilePath]
+ , flags :: [UserFlag]
+ } deriving (Show)
+
+instance FromJSON ToodlesConfig where
+ parseJSON (Object o) = do
+ parsedIgnore <- o .:? "ignore" .!= []
+ parsedFlags <- o .:? "flags" .!= []
+ return $ ToodlesConfig parsedIgnore parsedFlags
+ parseJSON invalid = typeMismatch "Invalid config" invalid
+
+app :: ToodlesState -> Application
+app s = serve toodlesAPI server
+
+ where
+ server :: Server ToodlesAPI
+ server = liftIO . getFullSearchResults s
+ :<|> deleteTodos s
+ :<|> editTodos s
+ :<|> serveDirectoryFileServer (dataPath s)
+ :<|> showRawFile s
+ :<|> root s
+
+root :: ToodlesState -> [Text] -> Handler Html
+root (ToodlesState _ dPath) path =
+ if null path then
+ liftIO $ BZ.preEscapedToHtml <$> readFile (dPath ++ "/html/index.html")
+ else throwError $ err404 { errBody = "Not found" }
+
+showRawFile :: ToodlesState -> Integer -> Handler Html
+showRawFile (ToodlesState ref _) eId = do
+ (TodoListResult r _) <- liftIO $ readIORef ref
+ let entry = find (\t -> entryId t == eId) r
+ liftIO $
+ maybe
+ (return "Not found")
+ (\e -> addAnchors <$> readFile (sourceFile e))
+ entry
+
+ where
+ addAnchors :: String -> Html
+ addAnchors s =
+ let codeLines = zip [1::Int ..] $ lines s
+ in BZ.preEscapedToHtml
+ (unlines $
+ map
+ (\(i, l) -> printf "%s
" (show i) l)
+ codeLines)
+
+editTodos :: ToodlesState -> EditTodoRequest -> Handler Text
+editTodos (ToodlesState ref _) req = do
+ (TodoListResult r _) <- liftIO $ readIORef ref
+ let editedList =
+ map
+ (\t ->
+ if willEditTodo req t
+ then editTodo req t
+ else t)
+ r
+ editedFilteredList = filter (willEditTodo req) editedList
+ _ <- mapM_ recordUpdates editedFilteredList
+ return "{}"
+ where
+ willEditTodo :: EditTodoRequest -> TodoEntry -> Bool
+ willEditTodo editRequest entry = entryId entry `elem` editIds editRequest
+
+ editTodo :: EditTodoRequest -> TodoEntry -> TodoEntry
+ editTodo editRequest entry =
+ let newAssignee =
+ if isJust (setAssignee editRequest) &&
+ (not . T.null . fromJust $ setAssignee editRequest)
+ then setAssignee editRequest
+ else assignee entry
+ newPriority =
+ if isJust (setPriority editRequest)
+ then setPriority editRequest
+ else priority entry
+ in entry
+ { assignee = newAssignee
+ , tags = tags entry ++ addTags editRequest
+ , priority = newPriority
+ , customAttributes =
+ nub $ customAttributes entry ++ addKeyVals editRequest
+ }
+
+ recordUpdates :: MonadIO m => TodoEntry -> m ()
+ recordUpdates t = void $ updateTodoLinesInFile renderTodo t
+
+renderTodo :: TodoEntry -> [Text]
+renderTodo t =
+ let ext = "." <> getExtension (sourceFile t)
+ comment =
+ if commentType t == SingleLine
+ then fromJust $ singleLineCommentForExtension ext
+ else fromJust $ multiLineOpenCommentForExtension ext
+ detail =
+ renderFlag (flag t) <> " (" <>
+ T.pack (
+ Data.String.Utils.join
+ "|"
+ (map T.unpack $
+ [fromMaybe "" $ assignee t] ++
+ listIfNotNull
+ (fmap (T.pack . maybe "" ((\n -> "p=" ++ n) . show)) priority t) ++
+ tags t ++ map (\a -> fst a <> "=" <> snd a) (customAttributes t))) <>
+ ") "
+ fullNoComments = mapHead (\l -> detail <> "- " <> l) $ body t
+ commentFn =
+ if commentType t == SingleLine
+ then (\l -> comment <> " " <> l)
+ else id
+ commented = map commentFn fullNoComments
+ in mapLast
+ (\line ->
+ if entryHeadClosed t
+ then line <> " " <> getMultiClosingForFileType ext
+ else line) .
+ mapHead (\l -> if entryHeadOpened t then leadingText t <> getMultiOpeningForFileType ext <> " " <> l else leadingText t <> l) .
+ mapInit
+ (\l -> foldl (<>) "" [" " | _ <- [1 .. (T.length $ leadingText t)]] <> l) $
+ commented
+ where
+ listIfNotNull :: Text -> [Text]
+ listIfNotNull "" = []
+ listIfNotNull s = [s]
+
+ renderFlag :: Flag -> Text
+ renderFlag TODO = "TODO"
+ renderFlag FIXME = "FIXME"
+ renderFlag XXX = "XXX"
+ renderFlag (UF (UserFlag x)) = x
+
+-- | Given a function to emit new lines for a given todo, write that update in
+-- place of the current todo lines
+updateTodoLinesInFile :: MonadIO m => (TodoEntry -> [Text]) -> TodoEntry -> m ()
+updateTodoLinesInFile f todo = do
+ let startIndex = lineNumber todo - 1
+ newLines = map T.unpack $ f todo
+ fileLines <- liftIO $ lines <$> SIO.readFile (sourceFile todo)
+ let updatedLines =
+ slice 0 (fromIntegral $ startIndex - 1) fileLines ++ newLines ++
+ slice
+ (fromIntegral startIndex + length (body todo))
+ (length fileLines - 1)
+ fileLines
+ liftIO $ writeFile (sourceFile todo) $ unlines updatedLines
+
+ where
+ slice :: Int -> Int -> [a] -> [a]
+ slice a b xs = take (b - a + 1) (drop a xs)
+
+deleteTodos :: ToodlesState -> DeleteTodoRequest -> Handler Text
+deleteTodos (ToodlesState ref _) req = do
+ refVal@(TodoListResult r _) <- liftIO $ readIORef ref
+ let toDelete = filter (\t -> entryId t `elem` ids req) r
+ liftIO $ doUntilNull removeAndAdjust toDelete
+ let remainingResults = filter (\t -> entryId t `notElem` map entryId toDelete) r
+ let updatedResults = foldl (flip adjustLinesAfterDeletionOf) remainingResults toDelete
+ let remainingResultsRef = refVal { todos = updatedResults }
+ _ <- liftIO $ atomicModifyIORef' ref (const (remainingResultsRef, remainingResultsRef))
+ return "{}"
+
+ where
+
+ doUntilNull :: ([a] -> IO [a]) -> [a] -> IO ()
+ doUntilNull f xs = do
+ result <- f xs
+ if null result
+ then return ()
+ else doUntilNull f result
+
+ -- If we delete an entry, we need to decrement the line-numbers for the
+ -- other entries that come later in the file
+ adjustLinesAfterDeletionOf :: TodoEntry -> [TodoEntry] -> [TodoEntry]
+ adjustLinesAfterDeletionOf deleted =
+ map (\remaining ->
+ if (sourceFile remaining == sourceFile deleted) && (lineNumber remaining > lineNumber deleted)
+ then remaining { lineNumber = lineNumber remaining - (fromIntegral . length $ body deleted)}
+ else remaining)
+
+ removeAndAdjust :: MonadIO m => [TodoEntry] -> m [TodoEntry]
+ removeAndAdjust [] = return []
+ removeAndAdjust (x:xs) = do
+ removeTodoFromCode x
+ return $ adjustLinesAfterDeletionOf x xs
+
+ where
+ removeTodoFromCode :: MonadIO m => TodoEntry -> m ()
+ removeTodoFromCode t =
+ let opening = [getMultiOpeningForFileType $ getExtension (sourceFile t) | entryHeadOpened t]
+ closing = [getMultiClosingForFileType $ getExtension (sourceFile t) | entryHeadClosed t]
+ finalList = if length opening /= length closing then opening ++ closing else [] in
+ updateTodoLinesInFile (const finalList) t
+
+setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs
+setAbsolutePath args = do
+ let pathOrDefault = if T.null . T.pack $ directory args
+ then "."
+ else directory args
+ absolute <- normalise_path <$> absolute_path pathOrDefault
+ return $ args {directory = absolute}
+
+getFullSearchResults :: ToodlesState -> Bool -> IO TodoListResult
+getFullSearchResults (ToodlesState ref _) recompute =
+ if recompute
+ then do
+ putStrLn "refreshing todo's"
+ userArgs <- toodlesArgs >>= setAbsolutePath
+ sResults <- runFullSearch userArgs
+ atomicModifyIORef' ref (const (sResults, sResults))
+ else putStrLn "cached read" >> readIORef ref
+
+runFullSearch :: ToodlesArgs -> IO TodoListResult
+runFullSearch userArgs = do
+ let projectRoot = directory userArgs
+ configExists <- doesFileExist $ projectRoot ++ "/.toodles.yaml"
+ config <- if configExists
+ then Y.decodeFileEither (projectRoot ++ "/.toodles.yaml")
+ else return . Right $ ToodlesConfig [] []
+ when (isLeft config)
+ $ putStrLn $ "[WARNING] Invalid .toodles.yaml: " ++ show config
+ let config' = fromRight (ToodlesConfig [] []) config
+ allFiles <- getAllFiles config' projectRoot
+ let parsedTodos = concatMap (runTodoParser $ userFlag userArgs ++ flags config') allFiles
+ filteredTodos = filter (filterSearch (assignee_search userArgs)) parsedTodos
+ resultList = limitSearch filteredTodos $ limit_results userArgs
+ indexedResults = map (\(i, r) -> r {entryId = i}) $ zip [1 ..] resultList
+ return $ TodoListResult indexedResults ""
+
+ where
+ filterSearch :: Maybe SearchFilter -> TodoEntry -> Bool
+ filterSearch Nothing _ = True
+ filterSearch (Just (AssigneeFilter (AssigneeFilterRegex query))) entry = fromMaybe "" (assignee entry) == query
+
+ limitSearch :: [TodoEntry] -> Int -> [TodoEntry]
+ limitSearch todoList 0 = todoList
+ limitSearch todoList n = take n todoList
+
+getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile]
+getAllFiles (ToodlesConfig ignoredPaths _) basePath =
+ E.catch
+ (do putStrLn $ printf "Running toodles for path: %s" basePath
+ files <- recurseDir SystemFS basePath
+ let validFiles = filter isValidFile files
+ mapM
+ (\f ->
+ SourceFile f . (map T.pack . lines) <$>
+ E.catch
+ (SIO.readFile f)
+ (\(e :: E.IOException) -> print e >> return ""))
+ validFiles)
+ (\(e :: E.IOException) ->
+ putStrLn ("Error reading " ++ basePath ++ ": " ++ show e) >> return [])
+
+ where
+
+ isValidFile :: FilePath -> Bool
+ isValidFile path = fileHasValidExtension && not ignoreFile
+
+ where
+
+ fileHasValidExtension :: Bool
+ fileHasValidExtension = any (\ext -> ext `T.isSuffixOf` T.pack path) (map extension fileTypeToComment)
+
+ ignoreFile :: Bool
+ ignoreFile =
+ let p = T.pack path
+ in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p ||
+ T.isSuffixOf "_pb2.py" p ||
+ any (\r -> path =~ r :: Bool) ignoredPaths
+
+mapHead :: (a -> a) -> [a] -> [a]
+mapHead f (x:xs) = f x : xs
+mapHead _ xs = xs
+
+mapInit :: (a -> a) -> [a] -> [a]
+mapInit f (x:xs) = x : map f xs
+mapInit _ x = x
+
+mapLast :: (a -> a) -> [a] -> [a]
+mapLast f xs
+ | null xs = []
+ | otherwise = init xs ++ [f $ last xs]
diff --git a/src/ToodlesApi.hs b/src/ToodlesApi.hs
new file mode 100644
--- /dev/null
+++ b/src/ToodlesApi.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DataKinds,
+ ScopedTypeVariables,
+ TypeOperators #-}
+
+module ToodlesApi where
+
+import Types
+
+import Data.Proxy (Proxy)
+import Data.Text (Text)
+import Servant
+import Servant.HTML.Blaze (HTML)
+import Text.Blaze.Html5 (Html)
+
+type ToodlesAPI = "todos" :> QueryFlag "recompute" :> Get '[JSON] TodoListResult
+
+ :<|> "todos" :> "delete" :> ReqBody '[JSON] DeleteTodoRequest :> Post '[JSON] Text
+
+ :<|> "todos" :> "edit" :> ReqBody '[JSON] EditTodoRequest :> Post '[JSON] Text
+
+ :<|> "static" :> Raw
+
+ :<|> "source_file" :> Capture "id" Integer :> Get '[HTML] Html
+
+ :<|> CaptureAll "anything-else" Text :> Get '[HTML] Html
+
+toodlesAPI :: Proxy ToodlesAPI
+toodlesAPI = Proxy
diff --git a/src/Types.hs b/src/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Types.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Types where
+
+import Data.Aeson (FromJSON, ToJSON, Value (String), parseJSON,
+ toJSON)
+import Data.Aeson.Types (typeMismatch)
+import Data.Data
+import Data.IORef (IORef)
+import Data.String (IsString)
+import Data.Text (Text)
+import qualified Data.Text as T (unpack)
+import GHC.Generics (Generic)
+
+data SourceFile = SourceFile
+ { fullPath :: FilePath
+ , sourceLines :: [Text]
+ } deriving (Show)
+
+type LineNumber = Integer
+
+data ToodlesState = ToodlesState
+ { results :: IORef TodoListResult,
+ dataPath :: FilePath
+ }
+
+data CommentType = SingleLine | MultiLine deriving (Show, Eq, Generic)
+instance ToJSON CommentType
+
+data TodoEntry
+ = TodoEntryHead { entryId :: Integer
+ , body :: [Text]
+ , assignee :: Maybe Text
+ , sourceFile :: FilePath
+ , lineNumber :: LineNumber
+ , priority :: Maybe Integer
+ , flag :: Flag
+ , customAttributes :: [(Text, Text)]
+ , tags :: [Text]
+ , leadingText :: Text
+ , commentType :: CommentType
+ , entryHeadOpened :: Bool
+ , entryHeadClosed :: Bool
+ }
+ | TodoBodyLine
+ Text -- the body
+ Bool -- has opening tag
+ Bool -- has closing tag
+ | TodoBodyLineCombined
+ [Text] -- the body
+ Bool -- has opening tag
+ Bool -- has closing tag
+ deriving (Show, Generic)
+instance ToJSON TodoEntry
+
+data TodoListResult = TodoListResult
+ { todos :: [TodoEntry]
+ , message :: Text
+ } deriving (Show, Generic)
+instance ToJSON TodoListResult
+
+newtype DeleteTodoRequest = DeleteTodoRequest
+ { ids :: [Integer]
+ } deriving (Show, Generic)
+instance FromJSON DeleteTodoRequest
+
+data EditTodoRequest = EditTodoRequest
+ { editIds :: [Integer]
+ , setAssignee :: Maybe Text
+ , addTags :: [Text]
+ , addKeyVals :: [(Text, Text)]
+ , setPriority :: Maybe Integer
+ } deriving (Show, Generic)
+instance FromJSON EditTodoRequest
+
+data Flag = TODO | FIXME | XXX | UF UserFlag
+ deriving (Generic)
+
+newtype UserFlag = UserFlag Text
+ deriving (Show, Eq, IsString, Data, Generic)
+
+instance Show Flag where
+ show TODO = "TODO"
+ show FIXME = "FIXME"
+ show XXX = "XXX"
+ show (UF (UserFlag x)) = T.unpack x
+
+instance ToJSON Flag where
+ toJSON TODO = Data.Aeson.String "TODO"
+ toJSON FIXME = Data.Aeson.String "FIXME"
+ toJSON XXX = Data.Aeson.String "XXX"
+ toJSON (UF (UserFlag x)) = Data.Aeson.String x
+
+instance FromJSON Flag where
+ parseJSON (Data.Aeson.String x) =
+ case x of
+ "TODO" -> pure TODO
+ "FIXME" -> pure FIXME
+ "XXX" -> pure XXX
+ _ -> pure $ UF $ UserFlag x
+ parseJSON invalid = typeMismatch "UserFlag" invalid
+
+instance ToJSON UserFlag where
+ toJSON (UserFlag x) = Data.Aeson.String x
+
+instance FromJSON UserFlag where
+ parseJSON (Data.Aeson.String x) = pure $ UserFlag x
+ parseJSON invalid = typeMismatch "UserFlag" invalid
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,118 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Parse
+import Types
+
+import Data.Either
+import qualified Data.Text as T
+import Test.Hspec
+import Text.Megaparsec
+
+bodyText (TodoBodyLine a _ _) = a
+bodyText t = T.unlines (body t)
+
+hasClosing (TodoBodyLine _ _ a) = a
+hasClosing t = entryHeadClosed t
+
+hasOpening (TodoBodyLine _ t _) = t
+hasOpening t = entryHeadOpened t
+
+defaultBodyLine = TodoBodyLine "default bad" False False
+
+main :: IO ()
+main = hspec $
+ describe "Toodles" $ do
+ let unknownStateParser = parse (parseTodo ParseStateUnknown [] "hello.hs" 10 ) ""
+ multiLineStateParser = parse (parseTodo ParseStateMultiLineComment [] "hello.hs" 10 ) ""
+ singleHaskellParser = parse (parseComment ParseStateSingleComment ".hs") ""
+ multiHaskellParser = parse (parseComment ParseStateMultiLineComment ".hs") ""
+
+ it "parses single line comments" $ do
+ let haskellSingleComment = " -- a plain comment"
+ singleParsed = singleHaskellParser haskellSingleComment
+ singleParsed `shouldSatisfy` isRight
+ bodyText (fromRight defaultBodyLine singleParsed) `shouldSatisfy` (`T.isInfixOf` "a plain comment")
+
+ it "parses lines of multiline comments" $ do
+ let haskellMultiComment = "a plain comment"
+ multiParsed = multiHaskellParser haskellMultiComment
+ multiParsed `shouldSatisfy` isRight
+ let result = fromRight defaultBodyLine multiParsed
+ hasClosing result `shouldBe` False
+
+ let multiParsedWithClosing = multiHaskellParser (haskellMultiComment <> " -} ")
+ multiParsedWithClosing `shouldSatisfy` isRight
+ let result2 = fromRight defaultBodyLine multiParsedWithClosing
+ bodyText result2 `shouldSatisfy` ((`T.isInfixOf` "a plain comment"))
+ hasClosing result2 `shouldBe` True
+
+ it "parses multiline comment closings" $ do
+ let haskellMultiClose = "-}"
+ let multiCloseParsed = multiHaskellParser haskellMultiClose
+ multiCloseParsed `shouldSatisfy` isRight
+ let result3 = fromRight defaultBodyLine multiCloseParsed
+ hasClosing result3 `shouldBe` True
+ hasOpening result3 `shouldBe` False
+
+ it "parses multiline comment opens" $ do
+ let emptyMultiOpen = " {- "
+ emptyOpen = unknownStateParser emptyMultiOpen
+ emptyOpen `shouldSatisfy` isRight
+ let result5 = fromRight defaultBodyLine emptyOpen
+ hasOpening result5 `shouldBe` True
+ hasClosing result5 `shouldBe` False
+
+ it "parses empty lines as multiline comments " $ do
+ let emptyMulti = ""
+ emptyMultiParsed = multiLineStateParser emptyMulti
+ emptyMultiParsed `shouldSatisfy` isRight
+ let result6 = fromRight defaultBodyLine emptyMultiParsed
+ hasOpening result6 `shouldBe` False
+ hasClosing result6 `shouldBe` False
+
+ it "parses single TODOs" $ do
+ let haskellSingleTodo = " -- TODO(avi|p=1|#tag|key=val) some stuff we need to fix"
+ singleParsed = unknownStateParser haskellSingleTodo
+ singleParsed `shouldSatisfy` isRight
+ bodyText (fromRight defaultBodyLine singleParsed) `shouldBe` "some stuff we need to fix\n"
+
+ it "parses a multiline TODO fully enclosed on one line" $ do
+ let haskellEnclosedTodo = " {- TODO(avi|p=1|#tag|key=val) some stuff we need to fix -} "
+ multiParsed = unknownStateParser haskellEnclosedTodo
+ multiParsed `shouldSatisfy` isRight
+ let result2 = fromRight defaultBodyLine multiParsed
+ bodyText result2 `shouldBe` "some stuff we need to fix \n"
+ hasClosing result2 `shouldBe` True
+ hasOpening result2 `shouldBe` True
+
+ it "parses mutline TODO's on an opening line" $ do
+ let haskellMultiOpenTodo = " {- TODO(avi|p=1|#tag|key=val) some stuff we need to fix"
+ multiOpenParsed = unknownStateParser haskellMultiOpenTodo
+ multiOpenParsed `shouldSatisfy` isRight
+ let result3 = fromRight defaultBodyLine multiOpenParsed
+ bodyText result3 `shouldBe` "some stuff we need to fix\n"
+ hasClosing result3 `shouldBe` False
+ hasOpening result3 `shouldBe` True
+
+ it "parses mutline TODO's on a closing line" $ do
+ let haskellMultiCloseTodo = " TODO(avi|p=1|#tag|key=val) some stuff we need to fix -}"
+ unknownStateParser haskellMultiCloseTodo `shouldSatisfy` isLeft
+
+ let mutliCloseParsed = multiLineStateParser haskellMultiCloseTodo
+ mutliCloseParsed `shouldSatisfy` isRight
+ let result4 = fromRight defaultBodyLine mutliCloseParsed
+ bodyText result4 `shouldBe` "some stuff we need to fix \n"
+ hasClosing result4 `shouldBe` True
+ hasOpening result4 `shouldBe` False
+
+ it "parses bare TODO's in the middle of an opening line" $ do
+ let haskellBareMultiTodo = " TODO(avi|p=1|#tag|key=val) some stuff we need to fix"
+ bareMultiParsed = multiLineStateParser haskellBareMultiTodo
+ bareMultiParsed `shouldSatisfy` isRight
+ let result7 = fromRight defaultBodyLine bareMultiParsed
+ hasOpening result7 `shouldBe` False
+ hasClosing result7 `shouldBe` False
+ bodyText result7 `shouldBe` "some stuff we need to fix\n"
+
diff --git a/toodles.cabal b/toodles.cabal
--- a/toodles.cabal
+++ b/toodles.cabal
@@ -1,6 +1,6 @@
cabal-version: 1.12
name: toodles
-version: 0.1.4
+version: 1.0.0
license: MIT
license-file: LICENSE
copyright: 2018 Avi Press
@@ -31,9 +31,41 @@
type: git
location: https://github.com/aviaviavi/toodles
+library
+ exposed-modules:
+ Parse
+ Types
+ Config
+ ToodlesApi
+ Server
+ hs-source-dirs: src
+ other-modules:
+ Paths_toodles
+ default-language: Haskell2010
+ ghc-options: -Wall -Wcompat
+ build-depends:
+ MissingH >=1.4.0.1 && <1.5,
+ aeson ==1.3.1.1,
+ base >=4.0 && <5,
+ blaze-html ==0.9.1.1,
+ cmdargs ==0.10.20,
+ directory ==1.3.1.5,
+ hspec >=2.4.4 && <2.6,
+ hspec-expectations >=0.8.2 && <0.9,
+ megaparsec ==6.5.0,
+ regex-posix ==0.95.2,
+ servant ==0.14.1,
+ servant-blaze ==0.8,
+ servant-server ==0.14.1,
+ strict ==0.3.2,
+ text ==1.2.3.1,
+ wai ==3.2.1.2,
+ warp ==3.2.25,
+ yaml ==0.8.32
+
executable toodles
main-is: Main.hs
- hs-source-dirs: app
+ hs-source-dirs: app src
other-modules:
Config
Parse
@@ -51,6 +83,8 @@
blaze-html ==0.9.1.1,
cmdargs ==0.10.20,
directory ==1.3.1.5,
+ hspec >=2.4.4 && <2.6,
+ hspec-expectations >=0.8.2 && <0.9,
megaparsec ==6.5.0,
regex-posix ==0.95.2,
servant ==0.14.1,
@@ -58,6 +92,40 @@
servant-server ==0.14.1,
strict ==0.3.2,
text ==1.2.3.1,
+ wai ==3.2.1.2,
+ warp ==3.2.25,
+ yaml ==0.8.32
+
+test-suite toodles-test
+ type: exitcode-stdio-1.0
+ main-is: Spec.hs
+ hs-source-dirs: test src
+ other-modules:
+ Config
+ Parse
+ Server
+ ToodlesApi
+ Types
+ Paths_toodles
+ default-language: Haskell2010
+ ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N -w
+ build-depends:
+ MissingH >=1.4.0.1 && <1.5,
+ aeson ==1.3.1.1,
+ base >=4.0 && <5,
+ blaze-html ==0.9.1.1,
+ cmdargs ==0.10.20,
+ directory ==1.3.1.5,
+ hspec >=2.4.4 && <2.6,
+ hspec-expectations >=0.8.2 && <0.9,
+ megaparsec ==6.5.0,
+ regex-posix ==0.95.2,
+ servant ==0.14.1,
+ servant-blaze ==0.8,
+ servant-server ==0.14.1,
+ strict ==0.3.2,
+ text ==1.2.3.1,
+ toodles -any,
wai ==3.2.1.2,
warp ==3.2.25,
yaml ==0.8.32
diff --git a/web/html/index.html b/web/html/index.html
--- a/web/html/index.html
+++ b/web/html/index.html
@@ -39,7 +39,7 @@
-
+
Deselect All