diff --git a/src/Config.hs b/src/Config.hs --- a/src/Config.hs +++ b/src/Config.hs @@ -9,7 +9,7 @@ import Data.FileEmbed (embedFile) version :: Text -version = "1.8.2" +version = "1.9.0" usage :: Text usage = decodeUtf8 $(embedFile "templates/usage.txt") diff --git a/src/Data/Taskell/Task.hs b/src/Data/Taskell/Task.hs --- a/src/Data/Taskell/Task.hs +++ b/src/Data/Taskell/Task.hs @@ -9,6 +9,7 @@ , subtasks , blank , new + , create , duplicate , setDescription , appendDescription diff --git a/src/Data/Taskell/Task/Internal.hs b/src/Data/Taskell/Task/Internal.hs --- a/src/Data/Taskell/Task/Internal.hs +++ b/src/Data/Taskell/Task/Internal.hs @@ -27,6 +27,9 @@ $(makeLenses ''Task) -- operations +create :: Text -> Maybe Due -> Maybe Text -> Seq ST.Subtask -> Task +create name' due' description' subtasks' = Task name' description' subtasks' due' + blank :: Task blank = Task "" Nothing empty Nothing diff --git a/src/IO/Keyboard/Parser.hs b/src/IO/Keyboard/Parser.hs --- a/src/IO/Keyboard/Parser.hs +++ b/src/IO/Keyboard/Parser.hs @@ -30,8 +30,8 @@ bindingP :: Parser [Binding] bindingP = lexeme $ (keyP <|> charP) `sepBy` char ',' -line :: Parser [(Binding, ActionType)] -line = +lineP :: Parser [(Binding, ActionType)] +lineP = stripComments $ do name <- read <$> word _ <- lexeme $ char '=' @@ -39,7 +39,7 @@ pure $ (, name) <$> binds bindingsP :: Parser Bindings -bindingsP = stripComments $ concat <$> many' line +bindingsP = stripComments $ concat <$> many' lineP -- run parser bindings :: Text -> Either Text Bindings diff --git a/src/IO/Markdown.hs b/src/IO/Markdown.hs --- a/src/IO/Markdown.hs +++ b/src/IO/Markdown.hs @@ -1,7 +1,8 @@ module IO.Markdown ( parse - , stringify + , serialize , MarkdownInfo(MarkdownInfo) ) where -import IO.Markdown.Internal +import IO.Markdown.Parser (parse) +import IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize) diff --git a/src/IO/Markdown/Internal.hs b/src/IO/Markdown/Internal.hs deleted file mode 100644 --- a/src/IO/Markdown/Internal.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module IO.Markdown.Internal where - -import ClassyPrelude - -import Control.Lens ((.~), (^.)) - -import Data.Sequence (adjust') -import qualified Data.Text as T (splitOn, strip) -import Data.Text.Encoding (decodeUtf8With) - -import Data.Time.Zones (TZ) - -import Data.Taskell.Date (Due, textToTime, timeToOutput, timeToOutputLocal) -import Data.Taskell.List (List, count, tasks, title, updateFn) -import Data.Taskell.Lists (Lists, appendToLast, newList) -import qualified Data.Taskell.Subtask as ST (Subtask, complete, name, new) -import qualified Data.Taskell.Task as T (Task, addSubtask, appendDescription, description, due, - name, new, subtasks) - -import qualified IO.Config as C (Config, markdown) -import IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes, - subtaskOutput, taskOutput, titleOutput) - -data MarkdownInfo = MarkdownInfo - { mdTZ :: TZ - , mdConfig :: Config - } - -type ReaderMarkdown = Reader MarkdownInfo Text - --- parse code -addSubItem :: Text -> Lists -> Lists -addSubItem t ls = adjust' updateList i ls - where - i = length ls - 1 - st - | "[ ] " `isPrefixOf` t = ST.new (drop 4 t) False - | "[x] " `isPrefixOf` t = ST.new (drop 4 t) True - | otherwise = ST.new t False - updateList l = updateFn j (T.addSubtask st) l - where - j = count l - 1 - -addDescription :: Text -> Lists -> Lists -addDescription t ls = adjust' updateList i ls - where - i = length ls - 1 - updateList l = updateFn j (T.appendDescription t) l - where - j = count l - 1 - -addDue :: Text -> Lists -> Lists -addDue t ls = adjust' updateList i ls - where - i = length ls - 1 - updateList l = updateFn j (T.due .~ textToTime t) l - where - j = count l - 1 - -prefix :: Config -> Text -> (Config -> Text) -> (Text -> Lists -> Lists) -> Maybe (Lists -> Lists) -prefix config str get set - | pre `isPrefixOf` str = Just $ set (drop (length pre) str) - | otherwise = Nothing - where - pre = get config `snoc` ' ' - -matches :: [(Config -> Text, Text -> Lists -> Lists)] -matches = - [ (titleOutput, newList) - , (taskOutput, appendToLast . T.new) - , (descriptionOutput, addDescription) - , (dueOutput, addDue) - , (subtaskOutput, addSubItem) - ] - -start :: Config -> (Lists, [Int]) -> (Text, Int) -> (Lists, [Int]) -start config (current, errs) (text, line) = - case find isJust $ uncurry (prefix config text) <$> matches of - Just (Just set) -> (set current, errs) - _ -> - if not (null (T.strip text)) - then (current, errs <> [line]) - else (current, errs) - -decodeError :: String -> Maybe Word8 -> Maybe Char -decodeError _ _ = Just '\65533' - -parse :: C.Config -> ByteString -> Either Text Lists -parse config s = do - let lns = lines $ decodeUtf8With decodeError s - let fn = start (C.markdown config) - let acc = (empty, []) - let (lists, errs) = foldl' fn acc $ zip lns [1 ..] - if null errs - then Right lists - else Left $ "could not parse line(s) " <> intercalate ", " (tshow <$> errs) - --- stringify code -subtaskSymbol :: Bool -> Text -subtaskSymbol True = "[x]" -subtaskSymbol False = "[ ]" - -subtaskStringify :: ST.Subtask -> ReaderMarkdown -subtaskStringify st = do - symbol <- subtaskOutput <$> asks mdConfig - pure . concat $ [symbol, " ", subtaskSymbol (st ^. ST.complete), " ", st ^. ST.name] - -descriptionStringify :: Text -> ReaderMarkdown -descriptionStringify desc = do - symbol <- descriptionOutput <$> asks mdConfig - let add d = concat [symbol, " ", d] - pure . intercalate "\n" $ add <$> T.splitOn "\n" desc - -dueStringify :: Due -> ReaderMarkdown -dueStringify time = do - symbol <- dueOutput <$> asks mdConfig - useLocal <- localTimes <$> asks mdConfig - tz <- asks mdTZ - let fn = - if useLocal - then timeToOutputLocal tz - else timeToOutput - pure $ concat [symbol, " ", fn time] - -nameStringify :: Text -> ReaderMarkdown -nameStringify desc = do - symbol <- taskOutput <$> asks mdConfig - pure $ concat [symbol, " ", desc] - -taskStringify :: T.Task -> ReaderMarkdown -taskStringify t = do - nameString <- nameStringify (t ^. T.name) - dueString <- fromMaybe "" <$> sequence (dueStringify <$> t ^. T.due) - descriptionString <- fromMaybe "" <$> sequence (descriptionStringify <$> t ^. T.description) - subtaskString <- intercalate "\n" <$> sequence (subtaskStringify <$> t ^. T.subtasks) - pure . unlines . filter (/= "") $ [nameString, dueString, descriptionString, subtaskString] - -listStringify :: List -> ReaderMarkdown -listStringify list = do - symbol <- titleOutput <$> asks mdConfig - taskString <- concat <$> sequence (taskStringify <$> list ^. tasks) - pure $ concat [symbol, " ", list ^. title, "\n\n", taskString] - -stringify :: Lists -> ReaderMarkdown -stringify ls = intercalate "\n" <$> sequence (listStringify <$> ls) diff --git a/src/IO/Markdown/Parser.hs b/src/IO/Markdown/Parser.hs new file mode 100644 --- /dev/null +++ b/src/IO/Markdown/Parser.hs @@ -0,0 +1,67 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module IO.Markdown.Parser + ( parse + ) where + +import ClassyPrelude + +import Data.Attoparsec.Text hiding (parse) + +import qualified Data.Taskell.Date as D (Due, textToTime) +import qualified Data.Taskell.List as L (List, create) +import qualified Data.Taskell.Lists as LS (Lists) +import qualified Data.Taskell.Subtask as ST (Subtask, new) +import qualified Data.Taskell.Task as T (Task, create) + +import IO.Config.Markdown (Config, descriptionOutput, dueOutput, subtaskOutput, taskOutput, + titleOutput) +import Utility.Parser (lexeme, line) + +-- config symbol parsing +type Symbol = (Config -> Text) -> Parser () + +symP :: Config -> Symbol +symP config fn = string (fn config) *> char ' ' $> () + +-- utility functions +emptyMay :: (MonoFoldable a) => a -> Maybe a +emptyMay a = + if null a + then Nothing + else Just a + +-- parsers +subtaskCompleteP :: Parser Bool +subtaskCompleteP = (== 'x') <$> (char '[' *> (char 'x' <|> char ' ') <* char ']' <* char ' ') + +subtaskP :: Symbol -> Parser ST.Subtask +subtaskP sym = flip ST.new <$> (sym subtaskOutput *> subtaskCompleteP) <*> line + +taskDescriptionP :: Symbol -> Parser (Maybe Text) +taskDescriptionP sym = emptyMay <$> (intercalate "\n" <$> many' (sym descriptionOutput *> line)) + +dueP :: Symbol -> Parser (Maybe D.Due) +dueP sym = (D.textToTime =<<) <$> optional (sym dueOutput *> line) + +taskNameP :: Symbol -> Parser Text +taskNameP sym = sym taskOutput *> line + +taskP :: Symbol -> Parser T.Task +taskP sym = + T.create <$> taskNameP sym <*> dueP sym <*> taskDescriptionP sym <*> + (fromList <$> many' (subtaskP sym)) + +listTitleP :: Symbol -> Parser Text +listTitleP sym = lexeme $ sym titleOutput *> line + +listP :: Symbol -> Parser L.List +listP sym = L.create <$> listTitleP sym <*> (fromList <$> many' (taskP sym)) + +markdownP :: Symbol -> Parser LS.Lists +markdownP sym = fromList <$> many1 (listP sym) <* endOfInput + +-- parse +parse :: Config -> Text -> Either Text LS.Lists +parse config txt = first (const "Could not parse file.") (parseOnly (markdownP (symP config)) txt) diff --git a/src/IO/Markdown/Serializer.hs b/src/IO/Markdown/Serializer.hs new file mode 100644 --- /dev/null +++ b/src/IO/Markdown/Serializer.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module IO.Markdown.Serializer + ( serialize + , MarkdownInfo(MarkdownInfo) + ) where + +import ClassyPrelude + +import Control.Lens ((^.)) + +import qualified Data.Text as T (splitOn) + +import Data.Time.Zones (TZ) + +import Data.Taskell.Date (Due, timeToOutput, timeToOutputLocal) +import Data.Taskell.List (List, tasks, title) +import Data.Taskell.Lists (Lists) +import qualified Data.Taskell.Subtask as ST (Subtask, complete, name) +import qualified Data.Taskell.Task as T (Task, description, due, name, subtasks) + +import IO.Config.Markdown (Config, descriptionOutput, dueOutput, localTimes, subtaskOutput, + taskOutput, titleOutput) + +data MarkdownInfo = MarkdownInfo + { mdTZ :: TZ + , mdConfig :: Config + } + +type ReaderMarkdown = Reader MarkdownInfo + +-- utility functions +askConf :: (Config -> a) -> ReaderMarkdown a +askConf fn = fn <$> asks mdConfig + +strMay :: (Applicative m) => (a -> m Text) -> Maybe a -> m Text +strMay _ Nothing = pure "" +strMay fn (Just a) = fn a + +space :: Text -> Text -> Text +space symbol txt = symbol <> " " <> txt + +timeFn :: ReaderMarkdown (Due -> Text) +timeFn = bool timeToOutput <$> (timeToOutputLocal <$> asks mdTZ) <*> askConf localTimes + +-- serializers +subtaskCompleteS :: Bool -> Text +subtaskCompleteS True = "[x]" +subtaskCompleteS False = "[ ]" + +subtaskS :: ST.Subtask -> ReaderMarkdown Text +subtaskS st = do + symbol <- askConf subtaskOutput + pure $ unwords [symbol, subtaskCompleteS (st ^. ST.complete), st ^. ST.name] + +subtasksS :: Seq ST.Subtask -> ReaderMarkdown Text +subtasksS sts = intercalate "\n" <$> sequence (subtaskS <$> sts) + +descriptionS :: Text -> ReaderMarkdown Text +descriptionS desc = do + symbol <- askConf descriptionOutput + pure . intercalate "\n" $ space symbol <$> T.splitOn "\n" desc + +dueS :: Due -> ReaderMarkdown Text +dueS due = do + symbol <- askConf dueOutput + fn <- timeFn + pure $ space symbol (fn due) + +nameS :: Text -> ReaderMarkdown Text +nameS desc = space <$> askConf taskOutput <*> pure desc + +taskS :: T.Task -> ReaderMarkdown Text +taskS t = + unlines . filter (/= "") <$> + sequence + [ nameS (t ^. T.name) + , strMay dueS (t ^. T.due) + , strMay descriptionS (t ^. T.description) + , subtasksS (t ^. T.subtasks) + ] + +listS :: List -> ReaderMarkdown Text +listS list = do + symbol <- askConf titleOutput + taskString <- concat <$> sequence (taskS <$> list ^. tasks) + pure . space symbol $ concat [list ^. title, "\n\n", taskString] + +-- serialize +serialize :: Lists -> ReaderMarkdown Text +serialize ls = intercalate "\n" <$> sequence (listS <$> ls) diff --git a/src/IO/Taskell.hs b/src/IO/Taskell.hs --- a/src/IO/Taskell.hs +++ b/src/IO/Taskell.hs @@ -8,6 +8,7 @@ import Control.Monad.Reader (runReader) import Data.FileEmbed (embedFile) +import Data.Text.Encoding (decodeUtf8With) import System.Directory (doesFileExist, getCurrentDirectory) import Data.Time.Zones (TZ) @@ -20,7 +21,7 @@ import qualified IO.Config.GitHub as GitHub (token) import qualified IO.Config.Trello as Trello (token) -import IO.Markdown (MarkdownInfo (MarkdownInfo), parse, stringify) +import IO.Markdown (MarkdownInfo (MarkdownInfo), parse, serialize) import qualified IO.HTTP.GitHub as GitHub (GitHubIdentifier, getLists) import qualified IO.HTTP.Trello as Trello (TrelloBoardID, getLists) @@ -147,8 +148,12 @@ writeData :: TZ -> Config -> Lists -> FilePath -> IO () writeData tz config tasks path = void (writeFile path output) where - output = encodeUtf8 $ runReader (stringify tasks) (MarkdownInfo tz (markdown config)) + output = encodeUtf8 $ runReader (serialize tasks) (MarkdownInfo tz (markdown config)) -- reads json file +decodeError :: String -> Maybe Word8 -> Maybe Char +decodeError _ _ = Just '\65533' + readData :: FilePath -> ReaderConfig (Either Text Lists) -readData path = parse <$> asks ioConfig <*> readFile path +readData path = + parse <$> (markdown <$> asks ioConfig) <*> (decodeUtf8With decodeError <$> readFile path) diff --git a/src/Utility/Parser.hs b/src/Utility/Parser.hs --- a/src/Utility/Parser.hs +++ b/src/Utility/Parser.hs @@ -9,5 +9,8 @@ lexeme :: Parser a -> Parser a lexeme p = skipSpace *> p <* skipSpace +line :: Parser Text +line = (takeTill isEndOfLine <* endOfLine) <|> takeText + word :: Parser Text word = lexeme $ pack <$> many1 letter diff --git a/taskell.cabal b/taskell.cabal --- a/taskell.cabal +++ b/taskell.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 name: taskell -version: 1.8.2.0 +version: 1.9.0.0 license: BSD3 license-file: LICENSE copyright: 2019 Mark Wales @@ -49,7 +49,8 @@ Events.State.Types Events.State.Types.Mode IO.Config.Markdown - IO.Markdown.Internal + IO.Markdown.Parser + IO.Markdown.Serializer IO.HTTP.GitHub IO.HTTP.Trello.List IO.HTTP.Trello.ChecklistItem @@ -160,7 +161,8 @@ IO.Keyboard.ParserTest IO.Keyboard.TypesTest IO.KeyboardTest - IO.MarkdownTest + IO.Markdown.ParserTest + IO.Markdown.SerializerTest IO.TrelloTest UI.FieldTest Paths_taskell diff --git a/test/IO/Markdown/ParserTest.hs b/test/IO/Markdown/ParserTest.hs new file mode 100644 --- /dev/null +++ b/test/IO/Markdown/ParserTest.hs @@ -0,0 +1,214 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module IO.Markdown.ParserTest + ( test_parser + ) where + +import ClassyPrelude + +import Test.Tasty + +import Test.Tasty.HUnit + +import Control.Lens ((&), (.~)) +import Data.FileEmbed (embedFile) + +import Data.Taskell.Date (textToTime) +import Data.Taskell.List (create) +import Data.Taskell.Lists (Lists, analyse, appendToLast, newList) + +import qualified Data.Taskell.Subtask as ST (new) +import Data.Taskell.Task (Task, addSubtask, due, new, setDescription) +import IO.Config.Markdown (Config (Config), defaultConfig, descriptionOutput, dueOutput, + localTimes, subtaskOutput, taskOutput, titleOutput) +import IO.Markdown.Parser (parse) + +-- error message +err :: Either Text Lists +err = Left "Could not parse file." + +-- complete taskell file +file :: Text +file = decodeUtf8 $(embedFile "test/IO/data/roadmap.md") + +-- alternative markdown configs +alternativeConfig :: Config +alternativeConfig = + Config + { titleOutput = "##" + , taskOutput = "###" + , descriptionOutput = ">" + , dueOutput = "@" + , subtaskOutput = "-" + , localTimes = True + } + +-- useful records +task :: Task +task = new "Test Item" + +list :: Lists +list = newList "Test" empty + +listWithItem :: Lists +listWithItem = appendToLast task list + +multiList :: Lists +multiList = + fromList + [create "Test" (fromList [new "Test Item"]), create "Test 2" (fromList [new "Test Item 2"])] + +makeSubTask :: Text -> Bool -> Lists +makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list + +taskWithSummary :: Task +taskWithSummary = setDescription "Summary" task + +taskWithMultiLineSummary :: Task +taskWithMultiLineSummary = setDescription "Summary Line 1\nSummary Line 2" task + +listWithSummaryItem :: Lists +listWithSummaryItem = appendToLast taskWithSummary list + +listWithMultiLineSummaryItem :: Lists +listWithMultiLineSummaryItem = appendToLast taskWithMultiLineSummary list + +taskWithDueDate :: Task +taskWithDueDate = task & due .~ textToTime "2018-04-12" + +listWithDueDateItem :: Lists +listWithDueDateItem = appendToLast taskWithDueDate list + +-- tests +test_parser :: TestTree +test_parser = + testGroup + "IO.Markdown" + [ testGroup + "Default Format" + [ testCase + "List Title" + (assertEqual "One list" (Right list) (parse defaultConfig "## Test")) + , testCase + "List item" + (assertEqual + "List item" + (Right listWithItem) + (parse defaultConfig "## Test\n\n- Test Item")) + , testCase + "Multiple Lists" + (assertEqual + "List item" + (Right multiList) + (parse defaultConfig "## Test\n\n- Test Item\n\n## Test 2\n\n- Test Item 2")) + , testCase + "Summary" + (assertEqual + "Summary" + (Right listWithSummaryItem) + (parse defaultConfig "## Test\n\n- Test Item\n > Summary")) + , testCase + "List Item with multi-line Summary" + (assertEqual + "List item with a summary" + (Right listWithMultiLineSummaryItem) + (parse + defaultConfig + "## Test\n\n- Test Item\n > Summary Line 1\n > Summary Line 2")) + , testCase + "Due Date" + (assertEqual + "Due Date" + (Right listWithDueDateItem) + (parse defaultConfig "## Test\n\n- Test Item\n @ 2018-04-12")) + , testCase + "Sub-Task" + (assertEqual + "List item with Sub-Task" + (Right (makeSubTask "Blah" False)) + (parse defaultConfig "## Test\n\n- Test Item\n * [ ] Blah")) + , testCase + "Complete Sub-Task" + (assertEqual + "List item with Sub-Task" + (Right (makeSubTask "Blah" True)) + (parse defaultConfig "## Test\n\n- Test Item\n * [x] Blah")) + ] + , testGroup + "Alternative Format" + [ testCase + "List Title" + (assertEqual "One list" (Right list) (parse alternativeConfig "## Test")) + , testCase + "List item" + (assertEqual + "List item" + (Right listWithItem) + (parse alternativeConfig "## Test\n\n### Test Item")) + , testCase + "Multiple Lists" + (assertEqual + "List item" + (Right multiList) + (parse + alternativeConfig + "## Test\n\n### Test Item\n\n## Test 2\n\n### Test Item 2")) + , testCase + "Summary" + (assertEqual + "Summary" + (Right listWithSummaryItem) + (parse alternativeConfig "## Test\n\n### Test Item\n> Summary")) + , testCase + "List Item with multi-line Summary" + (assertEqual + "List item with a summary" + (Right listWithMultiLineSummaryItem) + (parse + alternativeConfig + "## Test\n\n### Test Item\n> Summary Line 1\n> Summary Line 2")) + , testCase + "Due Date" + (assertEqual + "Due Date" + (Right listWithDueDateItem) + (parse alternativeConfig "## Test\n\n### Test Item\n@ 2018-04-12")) + , testCase + "Sub-Task" + (assertEqual + "List item with Sub-Task" + (Right (makeSubTask "Blah" False)) + (parse alternativeConfig "## Test\n\n### Test Item\n- [ ] Blah")) + , testCase + "Complete Sub-Task" + (assertEqual + "List item with Sub-Task" + (Right (makeSubTask "Blah" True)) + (parse alternativeConfig "## Test\n\n### Test Item\n- [x] Blah")) + ] + , testGroup + "Errors" + [ testCase "Blank line" (assertEqual "Parse Error" err (parse defaultConfig "")) + , testCase + "Just spaces" + (assertEqual "Parse Error" err (parse defaultConfig " ")) + , testCase + "Just whitespace" + (assertEqual "Parse Error" err (parse defaultConfig " \n \n \t ")) + , testCase "Error" (assertEqual "Parse Error" err (parse defaultConfig "Test")) + , testCase + "List item without list" + (assertEqual "Parse Error" err (parse defaultConfig "- Test Item")) + , testCase + "Sub task without list item" + (assertEqual "Parse Error" err (parse defaultConfig "## Test\n * Blah")) + ] + , testCase + "File" + (assertEqual + "Parses whole file" + (Right "test\nLists: 6\nTasks: 202") + (analyse "test" <$> parse defaultConfig file)) + ] diff --git a/test/IO/Markdown/SerializerTest.hs b/test/IO/Markdown/SerializerTest.hs new file mode 100644 --- /dev/null +++ b/test/IO/Markdown/SerializerTest.hs @@ -0,0 +1,194 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module IO.Markdown.SerializerTest + ( test_serializer + ) where + +import ClassyPrelude + +import Test.Tasty +import Test.Tasty.HUnit + +import Control.Lens ((&), (.~)) +import Control.Monad.Reader (runReader) +import Data.FileEmbed (embedFile) + +import Data.Time.Zones (utcTZ) +import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel) + +import Data.Taskell.Date (textToTime) +import qualified Data.Taskell.List as L (append, empty) +import Data.Taskell.Lists (Lists, appendToLast, newList) +import qualified Data.Taskell.Subtask as ST (new) +import Data.Taskell.Task (Task, addSubtask, due, new, setDescription) +import IO.Config.Markdown (Config (..), defaultConfig) +import IO.Markdown.Parser (parse) +import IO.Markdown.Serializer (MarkdownInfo (MarkdownInfo), serialize) + +-- complete taskell file +file :: Text +file = decodeUtf8 $(embedFile "test/IO/data/roadmap.md") + +-- alternative markdown configs +alternativeConfig :: Config +alternativeConfig = + Config + { titleOutput = "##" + , taskOutput = "###" + , descriptionOutput = ">" + , dueOutput = "@" + , subtaskOutput = "-" + , localTimes = True + } + +-- useful records +task :: Task +task = new "Test Item" + +list :: Lists +list = newList "Test" empty + +lists :: Lists +lists = fromList [L.append task (L.empty "To Do"), L.append (new "Fish") (L.empty "Done")] + +listWithItem :: Lists +listWithItem = appendToLast task list + +makeSubTask :: Text -> Bool -> Lists +makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list + +makeSubTasks :: [Text] -> Bool -> Lists +makeSubTasks ts b = appendToLast (foldr addSubtask task subtasks) list + where + subtasks = flip ST.new b <$> ts + +taskWithSummary :: Task +taskWithSummary = setDescription "Summary" task + +taskWithMultiLineSummary :: Task +taskWithMultiLineSummary = setDescription "Summary Line 1\nSummary Line 2" task + +listWithSummaryItem :: Lists +listWithSummaryItem = appendToLast taskWithSummary list + +listWithMultiLineSummaryItem :: Lists +listWithMultiLineSummaryItem = appendToLast taskWithMultiLineSummary list + +taskWithDueDate :: Task +taskWithDueDate = task & due .~ textToTime "2018-04-12" + +listWithDueDateItem :: Lists +listWithDueDateItem = appendToLast taskWithDueDate list + +taskWithDueTime :: Task +taskWithDueTime = task & due .~ textToTime "2018-04-12 12:00 UTC" + +listWithDueTimeItem :: Lists +listWithDueTimeItem = appendToLast taskWithDueTime list + +-- reader +defaultReader :: MarkdownInfo +defaultReader = MarkdownInfo utcTZ defaultConfig + +alternativeReader :: MarkdownInfo +alternativeReader = MarkdownInfo utcTZ alternativeConfig + +-- simplify tests +serialize' :: MarkdownInfo -> Lists -> Text +serialize' md ls = runReader (serialize ls) md + +-- tests +test_serializer :: TestTree +test_serializer = + testGroup + "IO.Markdown" + [ testGroup + "Serialisation" + [ testGroup + "Default Format" + [ testCase + "Standard lists" + (assertEqual + "Markdown formatted output" + "## To Do\n\n- Test Item\n\n## Done\n\n- Fish\n" + (serialize' defaultReader lists)) + , testCase + "Standard list" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n" + (serialize' defaultReader listWithItem)) + , testCase + "Standard list with summary" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n > Summary\n" + (serialize' defaultReader listWithSummaryItem)) + , testCase + "Standard list with date" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n @ 2018-04-12\n" + (serialize' defaultReader listWithDueDateItem)) + , testCase + "Standard list with date - timezone" + (assertEqual + "Use UTC timezone" + "## Test\n\n- Test Item\n @ 2018-04-12 12:00 UTC\n" + (serialize' + (MarkdownInfo (tzByLabel America__New_York) defaultConfig) + listWithDueTimeItem)) + , testCase + "Standard list with sub-task" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n * [x] Blah\n" + (serialize' defaultReader (makeSubTask "Blah" True))) + , testCase + "Standard list with sub-tasks" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n * [x] Blah\n * [x] Cow\n * [x] Spoon\n" + (serialize' + defaultReader + (makeSubTasks ["Spoon", "Cow", "Blah"] True))) + , testCase + "Standard list with multi-line summary" + (assertEqual + "Markdown formatted output" + "## Test\n\n- Test Item\n > Summary Line 1\n > Summary Line 2\n" + (serialize' defaultReader listWithMultiLineSummaryItem)) + ] + , testGroup + "Alternative Format" + [ testCase + "Standard list" + (assertEqual + "Markdown formatted output" + "## Test\n\n### Test Item\n" + (serialize' alternativeReader listWithItem)) + , testCase + "Standard list with sub-task" + (assertEqual + "Markdown formatted output" + "## Test\n\n### Test Item\n- [ ] Blah\n" + (serialize' alternativeReader (makeSubTask "Blah" False))) + , testCase + "Standard list with date - timezone" + (assertEqual + "Uses local timezone" + "## Test\n\n### Test Item\n@ 2018-04-12 08:00 EDT\n" + (serialize' + (MarkdownInfo (tzByLabel America__New_York) alternativeConfig) + listWithDueTimeItem)) + ] + ] + , testCase + "Parse then serialize" + (assertEqual + "Returns same text" + (Right file) + (serialize' defaultReader <$> parse defaultConfig file)) + ] diff --git a/test/IO/MarkdownTest.hs b/test/IO/MarkdownTest.hs deleted file mode 100644 --- a/test/IO/MarkdownTest.hs +++ /dev/null @@ -1,352 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module IO.MarkdownTest - ( test_markdown - ) where - -import ClassyPrelude - -import Test.Tasty -import Test.Tasty.ExpectedFailure (ignoreTest) -import Test.Tasty.HUnit - -import Control.Lens ((&), (.~)) -import Control.Monad.Reader (runReader) - -import Data.Time.Zones (utcTZ) -import Data.Time.Zones.All (TZLabel (America__New_York), tzByLabel) - -import Data.Taskell.Date (textToTime) -import qualified Data.Taskell.List as L (append, empty) -import Data.Taskell.Lists (Lists, appendToLast, newList) -import qualified Data.Taskell.Subtask as ST (new) -import Data.Taskell.Task (Task, addSubtask, due, new, setDescription) -import qualified IO.Config as C (defaultConfig) -import IO.Config.Markdown (Config (..), defaultConfig) -import IO.Markdown.Internal (MarkdownInfo (MarkdownInfo), parse, start, stringify) - --- alternative markdown configs -alternativeConfig :: Config -alternativeConfig = - Config - { titleOutput = "##" - , taskOutput = "###" - , descriptionOutput = ">" - , dueOutput = "@" - , subtaskOutput = "-" - , localTimes = True - } - --- useful records -task :: Task -task = new "Test Item" - -list :: Lists -list = newList "Test" empty - -lists :: Lists -lists = fromList [L.append task (L.empty "To Do"), L.append (new "Fish") (L.empty "Done")] - -listWithItem :: Lists -listWithItem = appendToLast task list - -makeSubTask :: Text -> Bool -> Lists -makeSubTask t b = appendToLast (addSubtask (ST.new t b) task) list - -makeSubTasks :: [Text] -> Bool -> Lists -makeSubTasks ts b = appendToLast (foldr addSubtask task subtasks) list - where - subtasks = flip ST.new b <$> ts - -taskWithSummary :: Task -taskWithSummary = setDescription "Summary" task - -taskWithMultiLineSummary :: Task -taskWithMultiLineSummary = setDescription "Summary Line 1\nSummary Line 2" task - -listWithSummaryItem :: Lists -listWithSummaryItem = appendToLast taskWithSummary list - -listWithMultiLineSummaryItem :: Lists -listWithMultiLineSummaryItem = appendToLast taskWithMultiLineSummary list - -taskWithDueDate :: Task -taskWithDueDate = task & due .~ textToTime "2018-04-12" - -listWithDueDateItem :: Lists -listWithDueDateItem = appendToLast taskWithDueDate list - -taskWithDueTime :: Task -taskWithDueTime = task & due .~ textToTime "2018-04-12 12:00 UTC" - -listWithDueTimeItem :: Lists -listWithDueTimeItem = appendToLast taskWithDueTime list - --- reader -defaultReader :: MarkdownInfo -defaultReader = MarkdownInfo utcTZ defaultConfig - -alternativeReader :: MarkdownInfo -alternativeReader = MarkdownInfo utcTZ alternativeConfig - --- simplify tests -stringify' :: MarkdownInfo -> Lists -> Text -stringify' md ls = runReader (stringify ls) md - --- tests -test_markdown :: TestTree -test_markdown = - testGroup - "IO.Markdown" - [ testGroup - "Line Parsing" - [ testGroup - "Default Format" - [ testCase - "List Title" - (assertEqual - "One list" - (list, []) - (start defaultConfig (empty, []) ("## Test", 1))) - , testCase - "Blank line" - (assertEqual - "Nothing" - (empty, []) - (start defaultConfig (empty, []) ("", 1))) - , testCase - "Just spaces" - (assertEqual - "Nothing" - (empty, []) - (start defaultConfig (empty, []) (" ", 1))) - , testCase - "Error" - (assertEqual - "Error on line 1" - (empty, [1]) - (start defaultConfig (empty, []) ("Test", 1))) - , testCase - "List item" - (assertEqual - "List item" - (listWithItem, []) - (start defaultConfig (list, []) ("- Test Item", 1))) - , testCase - "Summary" - (assertEqual - "Summary" - (listWithSummaryItem, []) - (start defaultConfig (listWithItem, []) (" > Summary", 1))) - , testCase - "Due Date" - (assertEqual - "Due Date" - (listWithDueDateItem, []) - (start defaultConfig (listWithItem, []) (" @ 2018-04-12", 1))) - , testCase - "Sub-Task" - (assertEqual - "List item with Sub-Task" - (makeSubTask "Blah" False, []) - (start defaultConfig (listWithItem, []) (" * Blah", 1))) - , testCase - "Complete Sub-Task" - (assertEqual - "List item with Sub-Task" - (makeSubTask "Blah" True, []) - (start defaultConfig (listWithItem, []) (" * [x] Blah", 1))) - , ignoreTest $ - testCase - "List item without list" - (assertEqual - "Parse Error" - (empty, [1]) - (start defaultConfig (empty, []) ("- Test Item", 1))) - , ignoreTest $ - testCase - "Sub task without list item" - (assertEqual - "Parse Error" - (list, [1]) - (start defaultConfig (list, []) (" * Blah", 1))) - ] - , testGroup - "Alternative Format" - [ testCase - "List Title" - (assertEqual - "One list" - (list, []) - (start alternativeConfig (empty, []) ("## Test", 1))) - , testCase - "Blank line" - (assertEqual - "Nothing" - (empty, []) - (start alternativeConfig (empty, []) ("", 1))) - , testCase - "Just spaces" - (assertEqual - "Nothing" - (empty, []) - (start alternativeConfig (empty, []) (" ", 1))) - , testCase - "Error" - (assertEqual - "Error on line 1" - (empty, [1]) - (start alternativeConfig (empty, []) ("* Test", 1))) - , testCase - "List item" - (assertEqual - "List item" - (listWithItem, []) - (start alternativeConfig (list, []) ("### Test Item", 1))) - , testCase - "Sub-Task" - (assertEqual - "List item with Sub-Task" - (makeSubTask "Blah" False, []) - (start alternativeConfig (listWithItem, []) ("- [ ] Blah", 1))) - , testCase - "Complete Sub-Task" - (assertEqual - "List item with Sub-Task" - (makeSubTask "Blah" True, []) - (start alternativeConfig (listWithItem, []) ("- [x] Blah", 1))) - , testCase - "Blank Sub-Task" - (assertEqual - "List item with blank Sub-Task" - (makeSubTask "" True, []) - (start alternativeConfig (listWithItem, []) ("- [x] ", 1))) - , testCase - "Sub-Task (old style)" - (assertEqual - "List item with Sub-Task" - (makeSubTask "Blah" False, []) - (start alternativeConfig (listWithItem, []) ("- Blah", 1))) - ] - ] - , testGroup - "Parsing" - [ testCase - "List Title" - (assertEqual - "One empty list" - (Right list) - (parse C.defaultConfig (encodeUtf8 "## Test"))) - , testCase - "List Items" - (assertEqual - "List with item" - (Right listWithItem) - (parse C.defaultConfig (encodeUtf8 "## Test\n- Test Item"))) - , testCase - "List Item with Summary" - (assertEqual - "List item with a summary" - (Right listWithSummaryItem) - (parse C.defaultConfig (encodeUtf8 "## Test\n- Test Item\n > Summary"))) - , testCase - "Parsing Errors" - (assertEqual - "Errors" - (Left "could not parse line(s) 3, 5") - (parse - C.defaultConfig - (encodeUtf8 "## Test\n- Test Item\n* Spoon\n- Test Item\nCow"))) - , testCase - "List Item with multi-line Summary" - (assertEqual - "List item with a summary" - (Right listWithMultiLineSummaryItem) - (parse - C.defaultConfig - (encodeUtf8 - "## Test\n- Test Item\n > Summary Line 1\n > Summary Line 2"))) - ] - , testGroup - "Stringification" - [ testGroup - "Default Format" - [ testCase - "Standard lists" - (assertEqual - "Markdown formatted output" - "## To Do\n\n- Test Item\n\n## Done\n\n- Fish\n" - (stringify' defaultReader lists)) - , testCase - "Standard list" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n" - (stringify' defaultReader listWithItem)) - , testCase - "Standard list with summary" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n > Summary\n" - (stringify' defaultReader listWithSummaryItem)) - , testCase - "Standard list with date" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n @ 2018-04-12\n" - (stringify' defaultReader listWithDueDateItem)) - , testCase - "Standard list with date - timezone" - (assertEqual - "Use UTC timezone" - "## Test\n\n- Test Item\n @ 2018-04-12 12:00 UTC\n" - (stringify' - (MarkdownInfo (tzByLabel America__New_York) defaultConfig) - listWithDueTimeItem)) - , testCase - "Standard list with sub-task" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n * [x] Blah\n" - (stringify' defaultReader (makeSubTask "Blah" True))) - , testCase - "Standard list with sub-tasks" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n * [x] Blah\n * [x] Cow\n * [x] Spoon\n" - (stringify' - defaultReader - (makeSubTasks ["Spoon", "Cow", "Blah"] True))) - , testCase - "Standard list with multi-line summary" - (assertEqual - "Markdown formatted output" - "## Test\n\n- Test Item\n > Summary Line 1\n > Summary Line 2\n" - (stringify' defaultReader listWithMultiLineSummaryItem)) - ] - , testGroup - "Alternative Format" - [ testCase - "Standard list" - (assertEqual - "Markdown formatted output" - "## Test\n\n### Test Item\n" - (stringify' alternativeReader listWithItem)) - , testCase - "Standard list with sub-task" - (assertEqual - "Markdown formatted output" - "## Test\n\n### Test Item\n- [ ] Blah\n" - (stringify' alternativeReader (makeSubTask "Blah" False))) - , testCase - "Standard list with date - timezone" - (assertEqual - "Uses local timezone" - "## Test\n\n### Test Item\n@ 2018-04-12 08:00 EDT\n" - (stringify' - (MarkdownInfo (tzByLabel America__New_York) alternativeConfig) - listWithDueTimeItem)) - ] - ] - ]