Parse tasks

Task.hs

@@ -1,7 +1,13 @@
 module Task where
 
+import DateExpr
+import Control.Applicative
+import Control.Monad
 import Data.Time.Calendar
-import DateExpressions
+import Data.Void
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
 
 data Priority = Must
               | Should
@@ -9,12 +15,96 @@ data Priority = Must
   deriving (Eq, Ord, Enum, Show)
 
 type Description = String
-type Amount = Int
-type Duration = Int
+type Amount = Integer
+type Duration = Integer
 
 data When = Forever
           | Until Day
           | During Duration Day
-          | While Duration BoolExpr
+          | 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