Fix parsing and add documentation
This commit is contained in:
parent
6fd0814057
commit
c2fb99cc1c
1 changed files with 111 additions and 40 deletions
|
|
@ -7,7 +7,10 @@
|
||||||
-- 1. A single line represents a single task
|
-- 1. A single line represents a single task
|
||||||
-- 2. Should be entirely human-readable and easily editable using a simple text viewer/editor
|
-- 2. Should be entirely human-readable and easily editable using a simple text viewer/editor
|
||||||
-- 3. When sorted alphabetically, should yield useful results
|
-- 3. When sorted alphabetically, should yield useful results
|
||||||
-- 4. Completing a task is as simple as changing the @-@ into a @x@
|
-- 4. Completing a task is as simple as changing the @"-"@ into @"x"@
|
||||||
|
--
|
||||||
|
-- [Incomplete task] @"-[ (\<priority\>)][ d\<due date\>][ c\<creation date\>] \<description\>"@
|
||||||
|
-- [Complete task] @"x[\<completion date\>][ (\<priority\>)][ d\<due date\>][ c\<creation date\>] \<description\>"@
|
||||||
|
|
||||||
module TaskMachine.Task
|
module TaskMachine.Task
|
||||||
( Task(..)
|
( Task(..)
|
||||||
|
|
@ -19,10 +22,14 @@ module TaskMachine.Task
|
||||||
, Snippet(..)
|
, Snippet(..)
|
||||||
-- * Formatting
|
-- * Formatting
|
||||||
, formatTask
|
, formatTask
|
||||||
|
, formatTasks
|
||||||
, formatDate
|
, formatDate
|
||||||
|
, formatDueDate
|
||||||
|
, formatCreationDate
|
||||||
, formatCompletion
|
, formatCompletion
|
||||||
, formatPriority
|
, formatPriority
|
||||||
, formatDescription
|
, formatDescription
|
||||||
|
, formatSnippet
|
||||||
-- * Parsing
|
-- * Parsing
|
||||||
-- ** Utilities
|
-- ** Utilities
|
||||||
, Parser
|
, Parser
|
||||||
|
|
@ -31,16 +38,16 @@ module TaskMachine.Task
|
||||||
-- ** Objects
|
-- ** Objects
|
||||||
, pTask
|
, pTask
|
||||||
, pTasks
|
, pTasks
|
||||||
, pDate
|
|
||||||
, pCompletion
|
, pCompletion
|
||||||
, pPriorityChar
|
, pPriorityChar
|
||||||
, pPriority
|
, pPriority
|
||||||
|
, pDate
|
||||||
, pDueDate
|
, pDueDate
|
||||||
, pCreationDate
|
, pCreationDate
|
||||||
, pDescription
|
, pDescription
|
||||||
|
, pSnippet
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative (liftA2)
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.List.NonEmpty as NE
|
||||||
import Data.Void
|
import Data.Void
|
||||||
|
|
@ -52,6 +59,7 @@ import Text.Megaparsec.Char
|
||||||
|
|
||||||
{- Task -}
|
{- Task -}
|
||||||
|
|
||||||
|
-- | A single task
|
||||||
data Task = Task
|
data Task = Task
|
||||||
{ taskCompleted :: Completion
|
{ taskCompleted :: Completion
|
||||||
, taskPriority :: Maybe Priority
|
, taskPriority :: Maybe Priority
|
||||||
|
|
@ -60,33 +68,62 @@ data Task = Task
|
||||||
, taskDescription :: Description
|
, taskDescription :: Description
|
||||||
} deriving (Show)
|
} deriving (Show)
|
||||||
|
|
||||||
|
-- | Convert a 'Task' to its string representation, which can be parsed by 'pTask'.
|
||||||
|
--
|
||||||
|
-- If this string representation is parsed using 'pTask', it should yield the original task,
|
||||||
|
-- with a few exceptions:
|
||||||
|
-- 'taskPriority', 'taskDue' and/or 'taskCreated' might be @Nothing@, but the 'taskDescription'
|
||||||
|
-- could include the text version of these in the beginning, i. e. @taskDescription = "(A) hello"@.
|
||||||
|
-- In that case, converting the task to a string and back yields a different result.
|
||||||
formatTask :: Task -> String
|
formatTask :: Task -> String
|
||||||
formatTask t
|
formatTask t
|
||||||
= formatCompletion (taskCompleted t) ++ " "
|
= formatCompletion (taskCompleted t) ++ " "
|
||||||
++ maybeWithSpace formatPriority (taskPriority t)
|
++ maybeWithSpace formatPriority (taskPriority t)
|
||||||
++ maybeWithSpace formatDate (taskDue t)
|
++ maybeWithSpace formatDueDate (taskDue t)
|
||||||
++ maybeWithSpace formatDate (taskCreated t)
|
++ maybeWithSpace formatCreationDate (taskCreated t)
|
||||||
++ formatDescription (taskDescription t)
|
++ formatDescription (taskDescription t)
|
||||||
where
|
where
|
||||||
maybeWithSpace :: (a -> String) -> Maybe a -> String
|
maybeWithSpace :: (a -> String) -> Maybe a -> String
|
||||||
maybeWithSpace _ Nothing = ""
|
maybeWithSpace _ Nothing = ""
|
||||||
maybeWithSpace f (Just a) = f a ++ " "
|
maybeWithSpace f (Just a) = f a ++ " "
|
||||||
|
|
||||||
--parseTasks :: FilePath -> String -> Either (ParseError Char Void) [Task]
|
-- | Convert a list of tasks to its string representation, which can be parsed by 'pTasks'.
|
||||||
--parseTasks = parse pTasks -- That's easy!
|
formatTasks :: [Task] -> String
|
||||||
|
formatTasks = concatMap ((++"\n") . formatTask)
|
||||||
|
|
||||||
{- Dates -}
|
{- Dates -}
|
||||||
|
|
||||||
|
-- | Convert a 'Day' to @YYYY-MM-DD@ format.
|
||||||
|
--
|
||||||
|
-- Example: @"2018-09-08"@
|
||||||
formatDate :: Day -> String
|
formatDate :: Day -> String
|
||||||
formatDate = show
|
formatDate = show
|
||||||
|
|
||||||
|
-- | Convert a 'Day' into the due date string representation, which can be parsed by 'pDueDate'.
|
||||||
|
--
|
||||||
|
-- Example: @"d2018-09-08"@
|
||||||
|
formatDueDate :: Day -> String
|
||||||
|
formatDueDate d = 'd' : formatDate d
|
||||||
|
|
||||||
|
-- | Convert a 'Day into the creation date string representation, which can be parsed by 'pCreationDate'.
|
||||||
|
--
|
||||||
|
-- Example: @"c2018-09-08"@
|
||||||
|
formatCreationDate :: Day -> String
|
||||||
|
formatCreationDate d = 'c' : formatDate d
|
||||||
|
|
||||||
{- Completion -}
|
{- Completion -}
|
||||||
|
|
||||||
|
-- | Whether a task has been completed or not.
|
||||||
|
--
|
||||||
|
-- May include the completion date if the task is complete.
|
||||||
data Completion
|
data Completion
|
||||||
= Incomplete
|
= Incomplete
|
||||||
| Complete (Maybe Day)
|
| Complete (Maybe Day)
|
||||||
deriving (Show)
|
deriving (Show)
|
||||||
|
|
||||||
|
-- | Convert a 'Completion' to its string representation, which can be parsed by 'pCompletion'.
|
||||||
|
--
|
||||||
|
-- Examples: @"-"@, @"x"@, @"x2018-09-08"@
|
||||||
formatCompletion :: Completion -> String
|
formatCompletion :: Completion -> String
|
||||||
formatCompletion Incomplete = "-"
|
formatCompletion Incomplete = "-"
|
||||||
formatCompletion (Complete Nothing) = "x"
|
formatCompletion (Complete Nothing) = "x"
|
||||||
|
|
@ -94,6 +131,7 @@ formatCompletion (Complete (Just day)) = "x " ++ formatDate day
|
||||||
|
|
||||||
{- Priority -}
|
{- Priority -}
|
||||||
|
|
||||||
|
-- | A task's priority, which can be any uppercase character from A to Z.
|
||||||
data Priority
|
data Priority
|
||||||
= PrioA | PrioB | PrioC | PrioD | PrioE | PrioF | PrioG
|
= PrioA | PrioB | PrioC | PrioD | PrioE | PrioF | PrioG
|
||||||
| PrioH | PrioI | PrioJ | PrioK | PrioL | PrioM | PrioN
|
| PrioH | PrioI | PrioJ | PrioK | PrioL | PrioM | PrioN
|
||||||
|
|
@ -101,12 +139,17 @@ data Priority
|
||||||
| PrioV | PrioW | PrioX | PrioY | PrioZ
|
| PrioV | PrioW | PrioX | PrioY | PrioZ
|
||||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||||
|
|
||||||
|
-- | Convert a 'Priority' to its string representation, which can be parsed by 'pPriority'.
|
||||||
|
--
|
||||||
|
-- Example: @"(A)"@
|
||||||
formatPriority :: Priority -> String
|
formatPriority :: Priority -> String
|
||||||
formatPriority p = '(' : priorityToChar p : ")"
|
formatPriority p = '(' : priorityToChar p : ")"
|
||||||
|
|
||||||
|
-- | Convert a Priority to the corresponding uppercase character from A to Z.
|
||||||
priorityToChar :: Priority -> Char
|
priorityToChar :: Priority -> Char
|
||||||
priorityToChar p = toEnum (fromEnum 'A' + fromEnum p)
|
priorityToChar p = toEnum (fromEnum 'A' + fromEnum p)
|
||||||
|
|
||||||
|
-- | Convert a character to the corresponding Priority, if possible.
|
||||||
charToPriority :: Char -> Maybe Priority
|
charToPriority :: Char -> Maybe Priority
|
||||||
charToPriority c
|
charToPriority c
|
||||||
| min_value <= value && value <= max_value = Just $ toEnum value
|
| min_value <= value && value <= max_value = Just $ toEnum value
|
||||||
|
|
@ -118,32 +161,47 @@ charToPriority c
|
||||||
|
|
||||||
{- Description -}
|
{- Description -}
|
||||||
|
|
||||||
|
-- | A bunch of snippets that make up the description of a task.
|
||||||
type Description = [Snippet]
|
type Description = [Snippet]
|
||||||
|
|
||||||
|
-- | Part of a task's description.
|
||||||
data Snippet
|
data Snippet
|
||||||
= Word String
|
= Word String
|
||||||
|
-- ^ A space-delimited word that is not any of the special variants listed below.
|
||||||
| Space String
|
| Space String
|
||||||
|
-- ^ One or more spaces that delimit words.
|
||||||
| Project String
|
| Project String
|
||||||
|
-- ^ A word beginning with @"+"@.
|
||||||
| Context String
|
| Context String
|
||||||
|
-- ^ A word beginning with @"\@"@.
|
||||||
| KeyValue String String
|
| KeyValue String String
|
||||||
|
-- ^ A word of the form @key:value@.
|
||||||
|
-- The key and value cannot contain any spaces.
|
||||||
|
-- The key cannot contain any @":"@ characters, but the value can.
|
||||||
deriving (Eq, Show)
|
deriving (Eq, Show)
|
||||||
|
|
||||||
|
-- | Convert a 'Description' into its string representation, which can be parsed by 'pDescription'.
|
||||||
|
--
|
||||||
|
-- Example: @"task for +project \@context"@
|
||||||
formatDescription :: Description -> String
|
formatDescription :: Description -> String
|
||||||
formatDescription = concatMap toString
|
formatDescription = concatMap formatSnippet
|
||||||
where
|
|
||||||
toString :: Snippet -> String
|
-- | Convert a 'Snippet' into its string representation, which can be parsed by 'pSnippet'.
|
||||||
toString (Word s) = s
|
formatSnippet :: Snippet -> String
|
||||||
toString (Space s) = s
|
formatSnippet (Word s) = s
|
||||||
toString (Project s) = '+' : s
|
formatSnippet (Space s) = s
|
||||||
toString (Context s) = '@' : s
|
formatSnippet (Project s) = '+' : s
|
||||||
toString (KeyValue k v) = k ++ ":" ++ v
|
formatSnippet (Context s) = '@' : s
|
||||||
|
formatSnippet (KeyValue k v) = k ++ ":" ++ v
|
||||||
|
|
||||||
{- Parsing -}
|
{- Parsing -}
|
||||||
|
|
||||||
|
-- | Simple megaparsec parser over 'String's.
|
||||||
type Parser = Parsec Void String
|
type Parser = Parsec Void String
|
||||||
|
|
||||||
-- Completion
|
-- Dates
|
||||||
|
|
||||||
|
-- | Parse a date in @YYYY-MM-DD@ format (see 'formatDate').
|
||||||
pDate :: Parser Day
|
pDate :: Parser Day
|
||||||
pDate = label "date" $ fromGregorian
|
pDate = label "date" $ fromGregorian
|
||||||
<$> integer
|
<$> integer
|
||||||
|
|
@ -155,11 +213,24 @@ pDate = label "date" $ fromGregorian
|
||||||
int :: Parser Int
|
int :: Parser Int
|
||||||
int = read <$> count 2 digitChar
|
int = read <$> count 2 digitChar
|
||||||
|
|
||||||
|
-- | Parse a date in the due date format (see 'formatDueDate').
|
||||||
|
pDueDate :: Parser Day
|
||||||
|
pDueDate = label "due date" $ char 'd' *> pDate
|
||||||
|
|
||||||
|
-- | Parse a date in the creation date format (see 'formatCreationDate').
|
||||||
|
pCreationDate :: Parser Day
|
||||||
|
pCreationDate = label "creation date" $ char 'c' *> pDate
|
||||||
|
|
||||||
|
-- Completion
|
||||||
|
|
||||||
|
-- | Parse a 'Completion' (see 'formatCompletion').
|
||||||
pCompletion :: Parser Completion
|
pCompletion :: Parser Completion
|
||||||
pCompletion = Incomplete <$ char '-'
|
pCompletion = Incomplete <$ char '-'
|
||||||
<|> char 'x' *> (Complete <$> maybeParse pDate)
|
<|> char 'x' *> (label "completion date" $ Complete <$> maybeParse pDate)
|
||||||
|
|
||||||
-- Priority
|
-- Priority
|
||||||
|
|
||||||
|
-- | Parse the priority character inside the parentheses (see 'charToPriority').
|
||||||
pPriorityChar :: Parser Priority
|
pPriorityChar :: Parser Priority
|
||||||
pPriorityChar = do
|
pPriorityChar = do
|
||||||
c <- anyChar
|
c <- anyChar
|
||||||
|
|
@ -168,16 +239,9 @@ pPriorityChar = do
|
||||||
Nothing -> failure (Just $ Tokens $ c NE.:| [])
|
Nothing -> failure (Just $ Tokens $ c NE.:| [])
|
||||||
(Set.singleton $ Label $ 'p' NE.:| "riority character")
|
(Set.singleton $ Label $ 'p' NE.:| "riority character")
|
||||||
|
|
||||||
|
-- | Parse a 'Priority' (see 'formatPriority').
|
||||||
pPriority :: Parser Priority
|
pPriority :: Parser Priority
|
||||||
pPriority = char '(' *> pPriorityChar <* char ')'
|
pPriority = label "priority" $ char '(' *> pPriorityChar <* char ')'
|
||||||
|
|
||||||
-- Dates
|
|
||||||
|
|
||||||
pDueDate :: Parser Day
|
|
||||||
pDueDate = char 'd' *> pDate
|
|
||||||
|
|
||||||
pCreationDate :: Parser Day
|
|
||||||
pCreationDate = char 'c' *> pDate
|
|
||||||
|
|
||||||
-- Description
|
-- Description
|
||||||
|
|
||||||
|
|
@ -201,30 +265,36 @@ pKeyValue = KeyValue <$> (keyBody <* char ':') <*> wordBody
|
||||||
where
|
where
|
||||||
keyBody = takeWhile1P (Just "key character") (not . (`elem` ": \n"))
|
keyBody = takeWhile1P (Just "key character") (not . (`elem` ": \n"))
|
||||||
|
|
||||||
|
-- | Parse a 'Description' (see 'formatDescription').
|
||||||
pDescription :: Parser Description
|
pDescription :: Parser Description
|
||||||
pDescription = pSnippet
|
pDescription = label "description" snippet
|
||||||
where
|
where
|
||||||
pEnd :: Parser Description
|
end :: Parser Description
|
||||||
pEnd
|
end = [] <$ (eof <|> void (char '\n')) <|> snippet
|
||||||
= [] <$ (eof <|> void (char '\n'))
|
snippet :: Parser Description
|
||||||
<|> pSnippet
|
snippet = (:) <$> pSnippet <*> end
|
||||||
pSnippet :: Parser Description
|
|
||||||
|
-- | Parse a 'Snippet' (see 'formatSnippet').
|
||||||
|
pSnippet :: Parser Snippet
|
||||||
pSnippet
|
pSnippet
|
||||||
= try (liftA2 (:) pSpace pEnd)
|
= try pSpace
|
||||||
<|> try (liftA2 (:) pProject pEnd)
|
<|> try pProject
|
||||||
<|> try (liftA2 (:) pContext pEnd)
|
<|> try pContext
|
||||||
<|> try (liftA2 (:) pKeyValue pEnd)
|
<|> try pKeyValue
|
||||||
<|> liftA2 (:) pWord pEnd
|
<|> pWord
|
||||||
<?> "description"
|
|
||||||
|
|
||||||
-- Task
|
-- Task
|
||||||
|
|
||||||
|
-- | Parse a parser and a single space afterwards.
|
||||||
andSpace :: Parser a -> Parser a
|
andSpace :: Parser a -> Parser a
|
||||||
andSpace = (<* char ' ')
|
andSpace = (<* char ' ')
|
||||||
|
|
||||||
|
-- | If the parser succeeds, return its results warpped in @Just@.
|
||||||
|
-- Otherwise, return @Nothing@.
|
||||||
maybeParse :: Parser a -> Parser (Maybe a)
|
maybeParse :: Parser a -> Parser (Maybe a)
|
||||||
maybeParse p = Just <$> try p <|> pure Nothing
|
maybeParse p = Just <$> try p <|> pure Nothing
|
||||||
|
|
||||||
|
-- | Parse a 'Task' (see 'formatTask').
|
||||||
pTask :: Parser Task
|
pTask :: Parser Task
|
||||||
pTask
|
pTask
|
||||||
= Task
|
= Task
|
||||||
|
|
@ -234,5 +304,6 @@ pTask
|
||||||
<*> maybeParse (andSpace pCreationDate)
|
<*> maybeParse (andSpace pCreationDate)
|
||||||
<*> pDescription
|
<*> pDescription
|
||||||
|
|
||||||
|
-- | Parse a list of 'Task's (see 'formatTasks').
|
||||||
pTasks :: Parser [Task]
|
pTasks :: Parser [Task]
|
||||||
pTasks = many pTask <* eof
|
pTasks = many pTask <* eof
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue