Start work on todo.txt parser
This commit is contained in:
parent
36b791d7e0
commit
1c75605cf3
4 changed files with 158 additions and 2 deletions
|
|
@ -23,6 +23,7 @@ dependencies:
|
|||
- base >= 4.7 && < 5
|
||||
- brick
|
||||
- ConfigFile
|
||||
- containers
|
||||
- megaparsec
|
||||
- optparse-applicative
|
||||
- sqlite-simple
|
||||
|
|
@ -33,7 +34,6 @@ dependencies:
|
|||
- vty
|
||||
- hspec
|
||||
- QuickCheck
|
||||
#- containers
|
||||
#- unordered-containers
|
||||
#- transformers
|
||||
#- async
|
||||
|
|
|
|||
97
src/TaskMachine/Todotxt/Dates.hs
Normal file
97
src/TaskMachine/Todotxt/Dates.hs
Normal file
|
|
@ -0,0 +1,97 @@
|
|||
-- | Read, parse and write files in the <https://github.com/todotxt/todo.txt todo.txt> format.
|
||||
|
||||
|
||||
module TaskMachine.Todotxt.Dates
|
||||
( Dates()
|
||||
, showDates
|
||||
-- * Modification
|
||||
, creationDate
|
||||
, completionDate
|
||||
, setCreationDate
|
||||
, setCompletionDate
|
||||
-- * Parsing
|
||||
, day
|
||||
, dates
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.Void
|
||||
|
||||
import Data.Time.Calendar
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
-- | The combination of creation and completion date of a task.
|
||||
--
|
||||
-- These two dates were combined because, according to the
|
||||
-- <https://github.com/todotxt/todo.txt/blob/master/README.md#todotxt-format-rules todo.txt format rules>,
|
||||
-- the creation date "must be specified if completion date is".
|
||||
data Dates
|
||||
= NoDate
|
||||
| CrDate Day
|
||||
| CrCoDate Day Day
|
||||
deriving (Show)
|
||||
|
||||
{- Modification -}
|
||||
|
||||
-- | Convert a 'Dates' to a string representation that can be used inside a todo.txt task
|
||||
-- and parsed by 'dates'
|
||||
showDates :: Dates -> String
|
||||
showDates NoDate = ""
|
||||
showDates (CrDate creation) = show creation
|
||||
showDates (CrCoDate creation completion) = show creation ++ " " ++ show completion
|
||||
|
||||
-- | Retrieve the creation date, if one exists
|
||||
creationDate :: Dates -> Maybe Day
|
||||
creationDate (CrCoDate day _) = Just day
|
||||
creationDate (CrDate day) = Just day
|
||||
creationDate NoDate = Nothing
|
||||
|
||||
-- | Retrieve the completion date, if one exists
|
||||
completionDate :: Dates -> Maybe Day
|
||||
completionDate (CrCoDate _ day) = Just day
|
||||
completionDate _ = Nothing
|
||||
|
||||
-- | Set the creation date to a specific value
|
||||
setCreationDate :: Day -> Dates -> Dates
|
||||
setCreationDate creation (CrCoDate _ completion) = CrCoDate creation completion
|
||||
setCreationDate creation _ = CrDate creation
|
||||
|
||||
-- | Set the completion date to a specific value.
|
||||
--
|
||||
-- The first argument is a default creation date, in case none exists.
|
||||
-- This is because a completion date can only exist in combination with a
|
||||
-- creation date, as per the todo.txt format.
|
||||
setCompletionDate :: Day -> Day -> Dates -> Dates
|
||||
setCompletionDate _ completion (CrCoDate creation _) = CrCoDate creation completion
|
||||
setCompletionDate creation completion _ = CrCoDate creation completion
|
||||
|
||||
{- Parsing -}
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
-- | Parse one date of the format @YYYY-MM-DD@ (with no leading or trailing spaces).
|
||||
day :: Parser Day
|
||||
day = label "date" $ do
|
||||
y <- integer
|
||||
void $ char '-'
|
||||
m <- int
|
||||
void $ char '-'
|
||||
d <- int
|
||||
pure $ fromGregorian y m d
|
||||
where
|
||||
integer :: Parser Integer
|
||||
integer = read <$> count 4 digitChar
|
||||
int :: Parser Int
|
||||
int = read <$> count 2 digitChar
|
||||
|
||||
-- | Parse either zero, one or two dates of the format @YYYY-MM-DD@ (with no leading or trailing spaces).
|
||||
--
|
||||
-- If only one date is present, it is interpreted as the creation date.
|
||||
dates :: Parser Dates
|
||||
dates = try datesCrCo <|> try datesCr <|> pure NoDate
|
||||
where
|
||||
datesCrCo :: Parser Dates
|
||||
datesCrCo = CrCoDate <$> day <*> (char ' ' *> day)
|
||||
datesCr :: Parser Dates
|
||||
datesCr = CrDate <$> day
|
||||
57
src/TaskMachine/Todotxt/Priority.hs
Normal file
57
src/TaskMachine/Todotxt/Priority.hs
Normal file
|
|
@ -0,0 +1,57 @@
|
|||
-- | Read, parse and write files in the <https://github.com/todotxt/todo.txt todo.txt> format.
|
||||
|
||||
|
||||
module TaskMachine.Todotxt.Priority
|
||||
( Priority()
|
||||
, priorityToChar
|
||||
, charToPriority
|
||||
, showPriority
|
||||
-- * Parsing
|
||||
, priority
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Data.List.NonEmpty
|
||||
import Data.Void
|
||||
|
||||
import Data.Set as Set
|
||||
import Data.Time.Calendar
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
import Text.Megaparsec.Error
|
||||
|
||||
data Priority
|
||||
= PrioA | PrioB | PrioC | PrioD | PrioE | PrioF | PrioG
|
||||
| PrioH | PrioI | PrioJ | PrioK | PrioL | PrioM | PrioN
|
||||
| PrioO | PrioP | PrioQ | PrioR | PrioS | PrioT | PrioU
|
||||
| PrioV | PrioW | PrioX | PrioY | PrioZ
|
||||
deriving (Bounded, Enum, Eq, Show, Ord)
|
||||
|
||||
priorityToChar :: Priority -> Char
|
||||
priorityToChar p = toEnum (fromEnum 'A' + fromEnum p)
|
||||
|
||||
charToPriority :: Char -> Maybe Priority
|
||||
charToPriority c
|
||||
| min_value <= value && value <= max_value = Just $ toEnum value
|
||||
| otherwise = Nothing
|
||||
where
|
||||
value = fromEnum c - fromEnum 'A'
|
||||
min_value = fromEnum (minBound :: Priority)
|
||||
max_value = fromEnum (maxBound :: Priority)
|
||||
|
||||
showPriority :: Priority -> String
|
||||
showPriority p = '(' : priorityToChar p : ")"
|
||||
|
||||
{- Parsing -}
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
priorityChar :: Parser Priority
|
||||
priorityChar = do
|
||||
c <- anyChar
|
||||
case charToPriority c of
|
||||
Just p -> pure p
|
||||
Nothing -> failure (Just $ Tokens $ c :| []) (Set.singleton $ Label $ 'p' :| "riority character")
|
||||
|
||||
priority :: Parser Priority
|
||||
priority = char '(' *> priorityChar <* char ')'
|
||||
|
|
@ -15,7 +15,7 @@
|
|||
# resolver:
|
||||
# name: custom-snapshot
|
||||
# location: "./custom-snapshot.yaml"
|
||||
resolver: lts-11.11
|
||||
resolver: lts-12.9
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
|
@ -40,6 +40,8 @@ packages:
|
|||
# Dependency packages to be pulled from upstream that are not in the resolver
|
||||
# (e.g., acme-missiles-0.3)
|
||||
# extra-deps: []
|
||||
extra-deps:
|
||||
- ConfigFile-1.1.4
|
||||
|
||||
# Override default flag values for local packages and extra-deps
|
||||
# flags: {}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue