110 lines
2.4 KiB
Haskell
110 lines
2.4 KiB
Haskell
module Task where
|
|
|
|
import DateExpr
|
|
import Control.Applicative
|
|
import Control.Monad
|
|
import Data.Time.Calendar
|
|
import Data.Void
|
|
import Text.Megaparsec
|
|
import Text.Megaparsec.Char
|
|
import qualified Text.Megaparsec.Char.Lexer as L
|
|
|
|
data Priority = Must
|
|
| Should
|
|
| Can
|
|
deriving (Eq, Ord, Enum, Show)
|
|
|
|
type Description = String
|
|
type Amount = Integer
|
|
type Duration = Integer
|
|
|
|
data When = Forever
|
|
| Until Day
|
|
| During Duration Day
|
|
| Whenever Duration DateExpr
|
|
deriving (Show)
|
|
|
|
data Task = Task Priority Description Amount When
|
|
deriving (Show)
|
|
|
|
{-
|
|
- Parse Tasks
|
|
-}
|
|
|
|
type Parser = Parsec Void String
|
|
|
|
sc :: Parser ()
|
|
sc = L.space space1 (L.skipLineComment "//") (L.skipBlockCommentNested "/*" "*/")
|
|
|
|
symbol :: String -> Parser String
|
|
symbol = L.symbol sc
|
|
|
|
lexeme :: Parser a -> Parser a
|
|
lexeme = L.lexeme sc
|
|
|
|
integer :: (Integral i) => Parser i
|
|
integer = lexeme L.decimal
|
|
|
|
options :: (a -> Parser a) -> [a] -> Parser a
|
|
options f = foldr1 (<|>) . map f
|
|
|
|
pDateIso :: Parser Day
|
|
pDateIso = do
|
|
y <- integer
|
|
char '-'
|
|
m <- integer
|
|
char '-'
|
|
d <- integer
|
|
return $ fromGregorian y m d
|
|
|
|
pDateDots :: Parser Day
|
|
pDateDots = do
|
|
d <- integer
|
|
char '.'
|
|
m <- integer
|
|
char '.'
|
|
y <- integer
|
|
return $ fromGregorian y m d
|
|
|
|
pDate :: Parser Day
|
|
pDate = try pDateIso <|> pDateDots
|
|
|
|
pDuration :: Parser Duration
|
|
pDuration = do
|
|
symbol "for"
|
|
n <- integer
|
|
symbol "days" <|> symbol "day"
|
|
return n
|
|
|
|
pUntil = symbol "until" *> pDate
|
|
pWhenever = symbol "whenever" *> parseDateExpr
|
|
|
|
pWhenShortcut :: Parser When
|
|
pWhenShortcut = Whenever 1 daily <$ symbol "daily"
|
|
<|> Whenever 7 weekly <$ symbol "weekly"
|
|
|
|
pWhen :: Parser When
|
|
pWhen = pWhenShortcut
|
|
<|> liftA Until pUntil
|
|
<|> try (liftA2 During pDuration pUntil)
|
|
<|> liftA2 Whenever pDuration pWhenever
|
|
<|> return Forever
|
|
|
|
pPriority :: Parser Priority
|
|
pPriority = Must <$ symbol "must"
|
|
<|> Should <$ symbol "should"
|
|
<|> Can <$ options symbol ["can", "might", "may"]
|
|
|
|
pAmount :: Parser Amount
|
|
pAmount = 1 <$ symbol "once"
|
|
<|> 2 <$ symbol "twice"
|
|
<|> integer <* (symbol "times" <|> symbol "time")
|
|
|
|
pDesc :: Parser Description
|
|
pDesc = between (symbol "<") (symbol ">")
|
|
$ takeWhile1P (Just "description") (not . (`elem` "<>"))
|
|
|
|
parseTask :: Parser Task
|
|
-- because liftA only goes up to liftA3
|
|
parseTask = try (liftM4 Task pPriority pDesc pAmount pWhen)
|
|
<|> liftM4 Task pPriority pDesc (return 1) pWhen
|