packages feed

taskell 1.8.2.0 → 1.9.0.0

raw patch · 14 files changed

+594/−512 lines, 14 files

Files

src/Config.hs view
@@ -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")
src/Data/Taskell/Task.hs view
@@ -9,6 +9,7 @@     , subtasks     , blank     , new+    , create     , duplicate     , setDescription     , appendDescription
src/Data/Taskell/Task/Internal.hs view
@@ -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
src/IO/Keyboard/Parser.hs view
@@ -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
src/IO/Markdown.hs view
@@ -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)
− src/IO/Markdown/Internal.hs 
@@ -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)
+ src/IO/Markdown/Parser.hs view
@@ -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)
+ src/IO/Markdown/Serializer.hs view
@@ -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)
src/IO/Taskell.hs view
@@ -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)
src/Utility/Parser.hs view
@@ -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
taskell.cabal view
@@ -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
+ test/IO/Markdown/ParserTest.hs view
@@ -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))+        ]
+ test/IO/Markdown/SerializerTest.hs view
@@ -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))+        ]
− test/IO/MarkdownTest.hs 
@@ -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))-                    ]-              ]-        ]