module Cron.Parser (parse) where

import Common (fromDigits)
import Control.Applicative (Alternative, empty, liftA2, many, some, (*>), (<$), (<|>))
import Control.Arrow (first, (>>>))
import qualified Cron.Expr as E
import Data.List.NonEmpty (NonEmpty ((:|)))
import Intro
import Text.Read (readMaybe)

type Token = Char

newtype Parser a = Parser {runParser :: [Token] -> Maybe (a, [Token])}

instance Functor Parser where
  fmap f (Parser p) = Parser (p >>> fmap (first f))

instance Applicative Parser where
  pure a = Parser (\input -> Just (a, input))
  Parser pF <*> Parser pA = Parser $ \input -> do
    (f, rest) <- pF input
    (a, s) <- pA rest
    pure (f a, s)

instance Alternative Parser where
  empty = Parser (const Nothing)
  Parser pA <|> Parser pB = Parser $ \input -> case (pA input, pB input) of
    (Nothing, expr) -> expr
    (expr, _) -> expr

match :: (Token -> Bool) -> Parser Token
match p = Parser $ \case
  t : ts | p t -> Just (t, ts)
  _ -> Nothing

token :: Token -> Parser Token
token = (==) >>> match

read :: (Token -> Maybe a) -> Parser a
read f = Parser $ \case
  t : ts -> case f t of
    Just x -> Just (x, ts)
    _ -> Nothing
  _ -> Nothing

sepBy1 :: Parser a -> Parser b -> Parser (NonEmpty a)
sepBy1 p s = liftA2 (:|) p (many (s *> p))

pair :: Parser a -> Parser b -> Parser c -> Parser (a, b)
pair p1 p2 s = liftA2 (,) p1 (s *> p2)

digit :: Parser Int
digit = read $ \case
  x | x `elem` ['0' .. '9'] -> readMaybe [x] :: Maybe Int
  _ -> Nothing

number :: Parser Int
number = fromDigits <$> some digit

--
-- Cron Exprs
--

cRange :: Parser E.Expr
cRange = uncurry E.Range <$> pair number number (token '-')

cStepL :: Parser E.StepLExpr
cStepL =
  (E.StepLEvery <$ token '*')
    <|> (uncurry E.StepLRange <$> pair number number (token '-'))

cStep :: Parser E.Expr
cStep = uncurry E.Step <$> pair cStepL number (token '/')

cMulti :: Parser E.Expr
cMulti = E.Multi <$> sepBy1 number (token ',')

cEvery :: Parser E.Expr
cEvery = E.Every <$ token '*'

cExpr :: Parser E.Expr
cExpr = cStep <|> cEvery <|> cRange <|> cMulti

parse :: [Token] -> Either String E.Expr
parse xs = case runParser cExpr xs of
  Nothing -> Left "Invalid cron expression"
  Just (expr, []) -> Right expr
  Just (_, rest) -> Left ("Invalid cron expression. Couldn't parse `" ++ rest ++ "`")