diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -77,6 +77,7 @@
- Shell / Bash
- Swift
- Typescript
+- Vue (scripts only)
- Yaml
Submit a PR if you'd like a language to be added. There will eventually be
@@ -103,6 +104,19 @@
$ toodles -d /path/to/your/project -p 9001
# or simply
$ toodles
+```
+#### Running with Docker
+
+For convenience this repository also provides a `Dockerfile` to automatically
+build toodles.
+
+```bash
+# to build container run:
+$ docker build -t toodles .
+# afterwards you can run the following command to execute toodles for the
+# directory you are currently in:
+$ docker run -it -v $(pwd):/repo -p 9001:9001 toodles
+
```
### Current Limitations
diff --git a/app/Config.hs b/app/Config.hs
new file mode 100644
--- /dev/null
+++ b/app/Config.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE DeriveDataTypeable,
+ DataKinds,
+ OverloadedStrings,
+ ScopedTypeVariables,
+ TypeOperators #-}
+
+module Config where
+
+import Paths_toodles
+
+import Data.Text (Text)
+import Data.Version (showVersion)
+import System.Console.CmdArgs
+
+data ToodlesArgs = ToodlesArgs
+ { directory :: FilePath
+ , assignee_search :: Maybe SearchFilter
+ , limit_results :: Int
+ , port :: Maybe Int
+ , no_server :: Bool
+ } 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"
+ } &= 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
@@ -1,589 +1,18 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
--- TODO (avi|p=3|#cleanup|key=val|k3y=asdf|key=1) - break this into modules
module Main where
-import qualified Control.Exception as E
-import Control.Monad
-import Control.Monad (forM)
-import Control.Monad.IO.Class
-import Data.Aeson
-import Data.Either
-import Data.IORef
-import Data.List
-import Data.Maybe
-import Data.Monoid
-import Data.Proxy
-import Data.String.Utils
-import qualified Data.Text as T
-import Data.Version (showVersion)
-import Data.Void
-import qualified Data.Yaml as Y
-import GHC.Generics
-import Network.Wai.Handler.Warp
+import Config
import Paths_toodles
-import Servant
-import Servant.HTML.Blaze
-import System.Console.CmdArgs
-import System.Directory
-import System.IO.HVFS
-import qualified System.IO.Strict as SIO
-import System.Path
-import System.Path.NameManip
-import qualified Text.Blaze.Html5 as BZ
-import Text.Megaparsec
-import Text.Megaparsec.Char
-import qualified Text.Megaparsec.Char.Lexer as L
-import Text.Printf
-import Text.Read
-import Text.Regex.Posix
-
-type LineNumber = Integer
-
-data TodoEntry
- = TodoEntryHead { id :: Integer
- , body :: [T.Text]
- , assignee :: Maybe T.Text
- , sourceFile :: FilePath
- , lineNumber :: LineNumber
- , priority :: Maybe Integer
- , customAttributes :: [(T.Text, T.Text)]
- , tags :: [T.Text]
- , leadingText :: T.Text }
- | TodoBodyLine T.Text
- deriving (Show, Generic)
-
-data TodoListResult = TodoListResult
- { todos :: [TodoEntry]
- , message :: T.Text
- } deriving (Show, Generic)
-
-newtype DeleteTodoRequest = DeleteTodoRequest
- { ids :: [Integer]
- } deriving (Show, Generic)
-
-data EditTodoRequest = EditTodoRequest
- { editIds :: [Integer]
- , setAssignee :: Maybe T.Text
- , addTags :: [T.Text]
- , addKeyVals :: [(T.Text, T.Text)]
- , setPriority :: Maybe Integer
- } deriving (Show, Generic)
-
-newtype ToodlesConfig = ToodlesConfig {
- ignore :: [FilePath]
- } deriving (Show, Generic)
-
-instance FromJSON TodoEntry
-
-instance ToJSON TodoEntry
-
-instance FromJSON TodoListResult
-
-instance ToJSON TodoListResult
-
-instance FromJSON DeleteTodoRequest
-
-instance ToJSON DeleteTodoRequest
-
-instance FromJSON EditTodoRequest
-
-instance ToJSON EditTodoRequest
-
-instance FromJSON ToodlesConfig
-
-type ToodlesAPI =
- "todos" :> QueryFlag "recompute" :> Get '[ JSON] TodoListResult :<|>
- "todos" :> "delete" :> ReqBody '[ JSON] DeleteTodoRequest :> Post '[ JSON] T.Text :<|>
- "todos" :> "edit" :> ReqBody '[ JSON] EditTodoRequest :> Post '[ JSON] T.Text :<|>
- "static" :> Raw :<|>
- "source_file" :> Capture "id" Integer :> Get '[ HTML] BZ.Html :<|>
- CaptureAll "anything-else" T.Text :> Get '[HTML] BZ.Html
-
-server :: ToodlesState -> Server ToodlesAPI
-server s =
- liftIO . getFullSearchResults s :<|>
- deleteTodos s :<|>
- editTodos s :<|>
- serveDirectoryFileServer (dataPath s) :<|>
- showRawFile s :<|>
- root s
-
-data ToodlesState = ToodlesState
- { results :: IORef TodoListResult,
- dataPath :: FilePath
- }
-
-toodlesAPI :: Proxy ToodlesAPI
-toodlesAPI = Proxy
-
-slice :: Int -> Int -> [a] -> [a]
-slice f t xs = take (t - f + 1) (drop f xs)
-
-doUntilNull :: ([a] -> IO [a]) -> [a] -> IO ()
-doUntilNull f xs = do
- result <- f xs
- if null result
- then return ()
- else doUntilNull f result
-
-removeTodoFromCode :: MonadIO m => TodoEntry -> m ()
-removeTodoFromCode = updateTodoLinesInFile (const [])
-
--- | 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 -> [T.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
-
-removeAndAdjust :: MonadIO io => [TodoEntry] -> io [TodoEntry]
-removeAndAdjust [] = return []
-removeAndAdjust (x:xs) = do
- removeTodoFromCode x
- forM xs $ \t ->
- if (sourceFile t == sourceFile x) &&
- (lineNumber t > lineNumber x)
- then return $ t { lineNumber = lineNumber t - (fromIntegral . length $ body x)
- }
- else return t
-
-deleteTodos :: ToodlesState -> DeleteTodoRequest -> Handler T.Text
-deleteTodos (ToodlesState ref _) req = do
- refVal@(TodoListResult r _) <- liftIO $ readIORef ref
- let toDelete = filter (\t -> Main.id t `elem` ids req) r
- liftIO $ doUntilNull removeAndAdjust toDelete
- let updeatedResults =
- refVal
- { todos =
- filter (\t -> Main.id t `notElem` map Main.id toDelete) r
- }
- _ <-
- liftIO $ atomicModifyIORef' ref (const (updeatedResults, updeatedResults))
- return "{}"
-
-editTodos :: ToodlesState -> EditTodoRequest -> Handler T.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 = Main.id 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 -> [T.Text]
-renderTodo t =
- let comment =
- fromJust $ lookup ("." <> getExtension (sourceFile t)) fileTypeToComment
- detail =
- "TODO (" <>
- (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
-
-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 :: T.Text -> [T.Text]
-listIfNotNull "" = []
-listIfNotNull s = [s]
-
-root :: ToodlesState -> [T.Text] -> Handler BZ.Html
-root (ToodlesState _ dPath) path =
- if null path then
- liftIO $ BZ.preEscapedToHtml <$> readFile (dPath ++ "/html/index.html")
- else throwError $ err404 { errBody = "Not found" }
-
-app :: ToodlesState -> Application
-app s = serve toodlesAPI $ server s
-
-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 attrs entryTags entryLeadingText) (TodoBodyLine l) =
- TodoEntryHead i (b ++ [l]) a p n entryPriority attrs entryTags entryLeadingText
-combineTodo _ _ = error "Can't combine todoEntry of these types"
-
-data SourceFile = SourceFile
- { fullPath :: FilePath
- , sourceLines :: [T.Text]
- } deriving (Show)
-
-newtype AssigneeFilterRegex =
- AssigneeFilterRegex T.Text
- deriving (Show, Data, Eq)
-
-newtype SearchFilter =
- AssigneeFilter AssigneeFilterRegex
- deriving (Show, Data, Eq)
-
-data ToodlesArgs = ToodlesArgs
- { directory :: FilePath
- , assignee_search :: Maybe SearchFilter
- , limit_results :: Int
- , port :: Maybe Int
- , no_server :: Bool
- } deriving (Show, Data, Typeable, 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"
- } &=
- summary ("toodles " ++ showVersion version) &=
- program "toodles" &=
- verbosity &=
- help "Manage TODO's directly from your codebase"
-
-fileTypeToComment :: [(T.Text, T.Text)]
-fileTypeToComment =
- [ (".c", "//")
- , (".cc", "//")
- , (".clj", ";;")
- , (".cpp", "//")
- , (".cxx", "//")
- , (".c++", "//")
- , (".cs", "//")
- , (".ex", "#")
- , (".erl", "%")
- , (".go", "//")
- , (".h", "//")
- , (".hh", "//")
- , (".hpp", "//")
- , (".hs", "--")
- , (".hxx", "//")
- , (".h++", "//")
- , (".java", "//")
- , (".js", "//")
- , (".kt", "//")
- , (".kts", "//")
- , (".lua", "--")
- , (".m", "//")
- , (".php", "//")
- , (".proto", "//")
- , (".py", "#")
- , (".rb", "#")
- , (".rs", "//")
- , (".scala", "//")
- , (".sh", "#")
- , (".swift", "///")
- , (".ts", "//")
- , (".txt", "")
- , (".yaml", "#")
- ]
-
-unkownMarker :: T.Text
-unkownMarker = "UNKNOWN-DELIMETER-UNKNOWN-DELIMETER-UNKNOWN-DELIMETER"
-
-getCommentForFileType :: T.Text -> T.Text
-getCommentForFileType extension =
- fromMaybe unkownMarker $ lookup adjustedExtension fileTypeToComment
- where
- adjustedExtension =
- if T.isPrefixOf "." extension
- then extension
- else "." <> extension
-
-type Parser = Parsec Void T.Text
-
-lexeme :: Parser a -> Parser a
-lexeme = L.lexeme space
-
-symbol :: T.Text -> Parser T.Text
-symbol = L.symbol space
-
-parseComment :: T.Text -> Parser TodoEntry
-parseComment extension
- = do
- _ <- manyTill anyChar (symbol $ getCommentForFileType extension)
- b <- many anyChar
- return . TodoBodyLine $ T.pack b
-
-integer :: Parser Integer
-integer = lexeme $ L.signed space L.decimal
-
-parsePriority :: Parser Integer
-parsePriority = do
- _ <- symbol "p="
- integer
-
-parseAssignee :: Parser String
-parseAssignee = many (noneOf [')', '|', '='])
-
--- TODO(avi|p=3|#cleanup) - fix and type this better
-parseDetails ::
- T.Text -> (Maybe T.Text, Maybe T.Text, [(T.Text, T.Text)], [T.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)
-
-inParens :: Parser a -> Parser a
-inParens = between (symbol "(") (symbol ")")
-
-stringToMaybe :: T.Text -> Maybe T.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
-
-prefixParserForFileType extension =
- let comment = symbol . getCommentForFileType $ extension
- orgMode =
- (try $ symbol "****") <|> (try $ symbol "***") <|> (try $ symbol "**") <|>
- (try $ symbol "*") <|>
- (symbol "-")
- in if extension == "org"
- then orgMode
- else comment
-
-parseTodoEntryHead :: FilePath -> LineNumber -> Parser TodoEntry
-parseTodoEntryHead path lineNum = do
- entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path)
- _ <- symbol "TODO"
- 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
- otherDetails
- entryTags
- (T.pack entryLeadingText)
-
-parseTodo :: FilePath -> LineNumber -> Parser TodoEntry
-parseTodo path lineNum =
- try (parseTodoEntryHead path lineNum) <|> parseComment (getExtension path)
-
-getAllFiles :: ToodlesConfig -> FilePath -> IO [SourceFile]
-getAllFiles config path =
- E.catch
- (do putStrLn $ printf "Running toodles for path: %s" path
- files <- recurseDir SystemFS path
- let validFiles = filter (isValidFile config) files
- -- TODO(avi|p=3|#cleanup) - make sure it's a file first
- 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 " ++ path ++ ": " ++ show e) >> return [])
-
-fileHasValidExtension :: FilePath -> Bool
-fileHasValidExtension path =
- any (\ext -> ext `T.isSuffixOf` T.pack path) (map fst fileTypeToComment)
-
-ignoreFile :: ToodlesConfig -> FilePath -> Bool
-ignoreFile (ToodlesConfig ignoredPaths) file =
- let p = T.pack file
- in T.isInfixOf "node_modules" p || T.isSuffixOf "pb.go" p ||
- T.isSuffixOf "_pb2.py" p ||
- any (\r -> file =~ r :: Bool) ignoredPaths
-
-getExtension :: FilePath -> T.Text
-getExtension path = last $ T.splitOn "." (T.pack path)
-
-isValidFile :: ToodlesConfig -> FilePath -> Bool
-isValidFile config f =
- fileHasValidExtension f && not (ignoreFile config f)
-
-runTodoParser :: SourceFile -> [TodoEntry]
-runTodoParser (SourceFile path ls) =
- let parsedTodoLines =
- map
- (\(lineNum, lineText) -> parseMaybe (parseTodo path lineNum) lineText)
- (zip [1 ..] ls)
- groupedTodos = foldl foldTodoHelper ([], False) parsedTodoLines
- in fst groupedTodos
-
--- fold fn to concatenate todos that a multiple, single line comments
-foldTodoHelper :: ([TodoEntry], Bool) -> Maybe TodoEntry -> ([TodoEntry], Bool)
-foldTodoHelper (todoEntries :: [TodoEntry], currentlyBuildingTodoLines :: Bool) 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)
-
-prettyFormat :: TodoEntry -> String
-prettyFormat (TodoEntryHead _ l a p n entryPriority _ _ _) =
- printf
- "Assignee: %s\n%s%s:%d\n%s"
- (fromMaybe "None" a)
- (maybe "" (\x -> "Priority: " ++ show x ++ "\n") entryPriority)
- p
- n
- (unlines $ map T.unpack l)
-prettyFormat (TodoBodyLine _) = error "Invalid type for prettyFormat"
-
-filterSearch :: Maybe SearchFilter -> (TodoEntry -> Bool)
-filterSearch Nothing = const True
-filterSearch (Just (AssigneeFilter (AssigneeFilterRegex query))) =
- \entry -> fromMaybe "" (assignee entry) == query
-
-limitSearch :: [TodoEntry] -> Int -> [TodoEntry]
-limitSearch todoList limit =
- if limit == 0
- then todoList
- else take limit todoList
-
-runFullSearch :: ToodlesArgs -> IO TodoListResult
-runFullSearch userArgs =
- let projectRoot = directory userArgs
- in do
- 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
- allFiles <- getAllFiles (fromRight (ToodlesConfig []) config) projectRoot
- let parsedTodos = concatMap runTodoParser allFiles
- filteredTodos =
- filter (filterSearch (assignee_search userArgs)) parsedTodos
- resultList = limitSearch filteredTodos $ limit_results userArgs
- indexedResults =
- map (\(i, r) -> r {Main.id = i}) $ zip [1 ..] resultList
- return $ TodoListResult indexedResults ""
-
-getFullSearchResults :: ToodlesState -> Bool -> IO TodoListResult
-getFullSearchResults (ToodlesState ref _) recompute =
- if recompute
- then do
- putStrLn "refreshing todo's"
- userArgs <- cmdArgs argParser >>= setAbsolutePath
- sResults <- runFullSearch userArgs
- atomicModifyIORef' ref (const (sResults, sResults))
- else putStrLn "cached read" >> readIORef ref
-
-showRawFile :: ToodlesState -> Integer -> Handler BZ.Html
-showRawFile (ToodlesState ref _) entryId = do
- (TodoListResult r _) <- liftIO $ readIORef ref
- let entry = find (\t -> Main.id t == entryId) r
- liftIO $
- maybe
- (return "Not found")
- (\e -> addAnchors <$> readFile (sourceFile e))
- entry
-
-addAnchors :: String -> BZ.Html
-addAnchors s =
- let codeLines = zip [1 ..] $ lines s
- in BZ.preEscapedToHtml $
- (unlines $
- map
- (\(i, l) -> printf "%s
" (show i) l)
- codeLines)
+import Server
+import Types
-setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs
-setAbsolutePath toodlesArgs =
- let pathOrDefault =
- if T.null . T.pack $ directory toodlesArgs
- then "."
- else directory toodlesArgs
- in do absolute <- normalise_path <$> absolute_path pathOrDefault
- return $ toodlesArgs {directory = absolute}
+import Data.IORef (newIORef)
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as T (unpack)
+import Network.Wai.Handler.Warp (run)
+import System.Console.CmdArgs (cmdArgs)
+import Text.Printf (printf)
main :: IO ()
main = do
@@ -597,3 +26,14 @@
dataDir <- (++ "/web") <$> getDataDir
putStrLn $ "serving on " ++ show webPort
run webPort $ app $ ToodlesState ref dataDir
+
+prettyFormat :: TodoEntry -> String
+prettyFormat (TodoEntryHead _ l a p n entryPriority _ _ _) =
+ printf
+ "Assignee: %s\n%s%s:%d\n%s"
+ (fromMaybe "None" a)
+ (maybe "" (\x -> "Priority: " ++ show x ++ "\n") entryPriority)
+ p
+ n
+ (unlines $ map T.unpack l)
+prettyFormat (TodoBodyLine _) = error "Invalid type for prettyFormat"
diff --git a/app/Parse.hs b/app/Parse.hs
new file mode 100644
--- /dev/null
+++ b/app/Parse.hs
@@ -0,0 +1,204 @@
+{-# 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)
+
+fileTypeToComment :: [(Text, Text)]
+fileTypeToComment =
+ [ (".c", "//")
+ , (".cc", "//")
+ , (".clj", ";;")
+ , (".cpp", "//")
+ , (".cxx", "//")
+ , (".c++", "//")
+ , (".cs", "//")
+ , (".ex", "#")
+ , (".erl", "%")
+ , (".go", "//")
+ , (".h", "//")
+ , (".hh", "//")
+ , (".hpp", "//")
+ , (".hs", "--")
+ , (".hxx", "//")
+ , (".h++", "//")
+ , (".java", "//")
+ , (".js", "//")
+ , (".kt", "//")
+ , (".kts", "//")
+ , (".lua", "--")
+ , (".m", "//")
+ , (".php", "//")
+ , (".proto", "//")
+ , (".py", "#")
+ , (".rb", "#")
+ , (".rs", "//")
+ , (".scala", "//")
+ , (".sh", "#")
+ , (".swift", "///")
+ , (".ts", "//")
+ , (".tsx", "//")
+ , (".txt", "")
+ , (".vue", "//")
+ , (".yaml", "#")
+ ]
+
+runTodoParser :: SourceFile -> [TodoEntry]
+runTodoParser (SourceFile path ls) =
+ let parsedTodoLines =
+ map
+ (\(lineNum, lineText) -> parseMaybe (parseTodo 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 attrs entryTags entryLeadingText) (TodoBodyLine l) =
+ TodoEntryHead i (b ++ [l]) a p n entryPriority 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 :: FilePath -> LineNumber -> Parser TodoEntry
+parseTodo path lineNum = try parseTodoEntryHead
+ <|> parseComment (getExtension path)
+
+ where
+ parseTodoEntryHead :: Parser TodoEntry
+ parseTodoEntryHead = do
+ entryLeadingText <- manyTill anyChar (prefixParserForFileType $ getExtension path)
+ _ <- symbol "TODO"
+ 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
+ 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
new file mode 100644
--- /dev/null
+++ b/app/Server.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE DeriveAnyClass,
+ DeriveGeneric,
+ DataKinds,
+ OverloadedStrings,
+ ScopedTypeVariables,
+ 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.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 GHC.Generics (Generic)
+import Servant
+import System.Console.CmdArgs
+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
+
+newtype ToodlesConfig = ToodlesConfig
+ { ignore :: [FilePath]
+ } deriving (Show, Generic, FromJSON)
+
+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 =
+ "TODO (" <>
+ (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]
+
+-- | 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 updeatedResults =
+ refVal
+ { todos =
+ filter (\t -> entryId t `notElem` map entryId toDelete) r
+ }
+ _ <- liftIO $ atomicModifyIORef' ref (const (updeatedResults, updeatedResults))
+ return "{}"
+
+ where
+ doUntilNull :: ([a] -> IO [a]) -> [a] -> IO ()
+ doUntilNull f xs = do
+ result <- f xs
+ if null result
+ then return ()
+ else doUntilNull f result
+
+ removeAndAdjust :: MonadIO m => [TodoEntry] -> m [TodoEntry]
+ removeAndAdjust [] = return []
+ removeAndAdjust (x:xs) = do
+ removeTodoFromCode x
+ forM xs $ \t -> return $
+ if (sourceFile t == sourceFile x) && (lineNumber t > lineNumber x)
+ then t { lineNumber = lineNumber t - (fromIntegral . length $ body x)}
+ else t
+
+ where
+ removeTodoFromCode :: MonadIO m => TodoEntry -> m ()
+ removeTodoFromCode = updateTodoLinesInFile (const [])
+
+setAbsolutePath :: ToodlesArgs -> IO ToodlesArgs
+setAbsolutePath toodlesArgs = do
+ let pathOrDefault = if T.null . T.pack $ directory toodlesArgs
+ then "."
+ else directory toodlesArgs
+ absolute <- normalise_path <$> absolute_path pathOrDefault
+ return $ toodlesArgs {directory = absolute}
+
+getFullSearchResults :: ToodlesState -> Bool -> IO TodoListResult
+getFullSearchResults (ToodlesState ref _) recompute =
+ if recompute
+ then do
+ putStrLn "refreshing todo's"
+ userArgs <- cmdArgs argParser >>= 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
+ allFiles <- getAllFiles (fromRight (ToodlesConfig []) config) projectRoot
+ let parsedTodos = concatMap runTodoParser 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
+ -- TODO(avi|p=3|#cleanup) - make sure it's a file first
+ 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
new file mode 100644
--- /dev/null
+++ b/app/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/app/Types.hs b/app/Types.hs
new file mode 100644
--- /dev/null
+++ b/app/Types.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE DeriveAnyClass,
+ DeriveGeneric #-}
+
+module Types where
+
+import Data.Aeson (ToJSON, FromJSON)
+import Data.IORef (IORef)
+import Data.Text (Text)
+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
+ , customAttributes :: [(Text, Text)]
+ , tags :: [Text]
+ , leadingText :: Text }
+ | TodoBodyLine Text
+ deriving (Show, Generic, ToJSON)
+
+data TodoListResult = TodoListResult
+ { todos :: [TodoEntry]
+ , message :: Text
+ } deriving (Show, Generic, ToJSON)
+
+newtype DeleteTodoRequest = DeleteTodoRequest
+ { ids :: [Integer]
+ } deriving (Show, Generic, FromJSON)
+
+data EditTodoRequest = EditTodoRequest
+ { editIds :: [Integer]
+ , setAssignee :: Maybe Text
+ , addTags :: [Text]
+ , addKeyVals :: [(Text, Text)]
+ , setPriority :: Maybe Integer
+ } deriving (Show, Generic, FromJSON)
diff --git a/toodles.cabal b/toodles.cabal
--- a/toodles.cabal
+++ b/toodles.cabal
@@ -1,6 +1,6 @@
cabal-version: >=1.10
name: toodles
-version: 0.1.0.14
+version: 0.1.0.15
license: MIT
copyright: 2018 Avi Press
maintainer: mail@avi.press
@@ -34,9 +34,14 @@
main-is: Main.hs
hs-source-dirs: app
other-modules:
+ Config
+ Parse
+ Server
+ ToodlesApi
+ Types
Paths_toodles
default-language: Haskell2010
- ghc-options: -threaded -rtsopts -with-rtsopts=-N
+ ghc-options: -threaded -rtsopts -O3 -Wall -with-rtsopts=-N
build-depends:
MissingH >=1.4.0.1 && <1.5,
aeson ==1.3.1.1,
@@ -44,8 +49,6 @@
blaze-html ==0.9.1.1,
cmdargs ==0.10.20,
directory ==1.3.1.5,
- filepath ==1.4.2,
- http-types ==0.12.2,
megaparsec ==6.5.0,
regex-posix ==0.95.2,
servant ==0.14.1,
@@ -53,7 +56,6 @@
servant-server ==0.14.1,
strict ==0.3.2,
text ==1.2.3.1,
- transformers ==0.5.5.0,
wai ==3.2.1.2,
warp ==3.2.25,
yaml ==0.8.32