{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |

module JL.Parser where

import           Control.Monad.Catch
import           Data.Functor
import qualified Data.HashMap.Strict as HM
import           Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import           JL.Tokenizer
import           JL.Types
import           Text.Parsec hiding (satisfy, anyToken)

parseText :: MonadThrow m => SourceName -> Text -> m Expression
parseText fp inp =
  case parse tokensTokenizer fp (inp) of
    Left e -> throwM (TokenizerError e)
    Right tokens' ->
      case runParser (expressionParser <* endOfTokens) 0 fp tokens' of
        Left e -> throwM (ParserError e)
        Right ast -> pure ast

expressionParser :: TokenParser Expression
expressionParser = pipes
  where
    pipes = do
      ps <- sepBy1 dollars (equalToken Bar)
      case ps of
        [p] -> pure p
        [] -> unexpected "empty expression"
        (p:ps') ->
          pure
            (foldl
               (\x y ->
                  ApplicationExpression
                    (ApplicationExpression
                       (VariableExpression (Variable "compose"))
                       x)
                    y)
               p
               ps')
    dollars = do
      ps <- sepBy1 dollarable (equalToken Dollar)
      case ps of
        [p] -> pure p
        (p:ps') -> pure (foldl ApplicationExpression p ps')
        [] -> unexpected "empty expression"
      where
        dollarable =
          array <|> record <|> lambda <|> ifParser <|> infix' <|> app <|> atomic
    array = do
      void (equalToken OpenBracket) <?> ("open bracket " <> curlyQuotes "[")
      es <- sepBy expressionParser (void (equalToken Comma))
      void (equalToken CloseBracket) <?> ("closing bracket " <> curlyQuotes "]")
      pure (ArrayExpression (V.fromList es))
    record = do
      _ <- equalToken OpenBrace
      pairs' <- sepBy pair (equalToken Comma <?> curlyQuotes ",")
      _ <- equalToken CloseBrace <?> ("closing brace " <> curlyQuotes "}")
      pure (RecordExpression (HM.fromList pairs'))
      where
        pair = do
          var <-
            fmap
              fst
              (consumeToken
                 (\case
                    VariableToken i -> Just i
                    _ -> Nothing)) <|>
            fmap
              fst
              (consumeToken
                 (\case
                    StringToken c -> Just c
                    _ -> Nothing))
          _ <- equalToken Colon
          e <- expressionParser
          pure (var, e)
    app = do
      left <- funcOp <?> "function expression"
      right <- many unambiguous <?> "function arguments"
      case right of
        [] -> pure left
        _ -> pure (foldl (ApplicationExpression) left right)
    infix' =
      (do left <- (app <|> unambiguous) <?> "left-hand side of operator"
          tok <- fmap Just (operator <?> "infix operator") <|> pure Nothing
          case tok of
            Just (Operator t, _) -> do
              right <-
                (app <|> unambiguous) <?>
                ("right-hand side of " ++
                 curlyQuotes (T.unpack t) ++ " operator")
              badop <- fmap Just (lookAhead operator) <|> pure Nothing
              let infixexp = InfixExpression left (Variable t) right
              maybe
                (return ())
                (\op ->
                   unexpected
                     (concat
                        [ tokenString op ++
                          ". When more than one operator is used\n"
                        , "in the same expression, use parentheses."
                        ]))
                badop
              pure infixexp
            _ -> pure left) <?>
      "infix expression (e.g. x * y)"
      where
        operator =
          satisfyToken
            (\case
               Operator {} -> True
               _ -> False)
    funcOp = do
      let collectsubscripts ks a = do
            bracket' <-
              fmap (const True) (equalToken OpenBracket) <|> pure False
            if bracket'
              then do
                k <- expressionParser
                _ <- equalToken CloseBracket
                collectsubscripts (ks . (ExpressionSubscript k :)) a
              else do
                dot <- fmap (const True) (equalToken Period) <|> pure False
                if dot
                  then do
                    k <-
                      fmap
                        fst
                        (consumeToken
                           (\case
                              VariableToken i -> Just i
                              Integer i -> Just (T.pack (show i))
                              _ -> Nothing))
                    collectsubscripts (ks . (PropertySubscript k :)) a
                  else pure (ks [], a)
      a <- varParser <|> parensExpr
      (subscripts, b) <- collectsubscripts id a
      if null subscripts
         then case b of
                VariableExpression (Variable "_") -> unexpected "wildcard without subscript"
                _ -> pure a
         else pure (SubscriptExpression
                      (case b of
                         VariableExpression (Variable "_") -> WildcardSubscripted
                         _ -> ExpressionSubscripted b)
                      subscripts)
    unambiguous = funcOp <|> record <|> atomic
    parensExpr = parens expressionParser

parens :: TokenParser a -> TokenParser a
parens p = go <?> "parens e.g. (x)"
  where
    go = do
      _ <- equalToken OpenParen
      e <- p <?> "expression inside parentheses e.g. (foo)"
      _ <- equalToken CloseParen <?> "closing parenthesis ‘)’"
      pure e

varParser :: TokenParser Expression
varParser = go <?> "variable (e.g. ‘foo’, ‘id’, etc.)"
  where
    go = do
      (v, _) <-
        consumeToken
          (\case
             VariableToken i -> Just i
             _ -> Nothing)
      pure
        (VariableExpression (Variable v))

ifParser :: TokenParser Expression
ifParser = go <?> "if expression (e.g. ‘if p then x else y’)"
  where
    go = do
      _ <- equalToken If
      p <- expressionParser <?> "condition expresion of if-expression"
      _ <- equalToken Then <?> "‘then’ keyword for if-expression"
      e1 <- expressionParser <?> "‘then’ clause of if-expression"
      _ <- equalToken Else <?> "‘else’ keyword for if-expression"
      e2 <- expressionParser <?> "‘else’ clause of if-expression"
      pure (IfExpression p e1 e2)

atomic :: TokenParser Expression
atomic =
  nullParser <|> boolParser <|> varParser <|> stringParser <|> integerParser <|>
  decimalParser
  where

    integerParser = go <?> "integer (e.g. 42, 123)"
      where
        go = do
          (c, _) <-
            consumeToken
              (\case
                 Integer c -> Just c
                 _ -> Nothing)
          pure (ConstantExpression (NumberConstant (fromIntegral c)))
    decimalParser = go <?> "decimal (e.g. 42, 123)"
      where
        go = do
          (c, _) <-
            consumeToken
              (\case
                 Decimal c -> Just c
                 _ -> Nothing)
          pure (ConstantExpression (NumberConstant (realToFrac c)))
    boolParser = go <?> "boolean (e.g. true, false)"
      where
        go = do
          (c, _) <-
            consumeToken
              (\case
                 TrueToken -> pure True
                 FalseToken -> pure False
                 _ -> Nothing)
          pure (ConstantExpression (BoolConstant c))
    nullParser = go <?> "null"
      where
        go = do
          ((), _) <-
            consumeToken
              (\case
                 NullToken -> pure ()
                 _ -> Nothing)
          pure (ConstantExpression NullConstant)

stringParser :: TokenParser Expression
stringParser = go <?> "string (e.g. \"a\")"
  where
    go = do
      (c, _) <-
        consumeToken
          (\case
             StringToken c -> Just c
             _ -> Nothing)
      pure (ConstantExpression (StringConstant c))

lambda :: TokenParser (Expression)
lambda = do
  _ <- equalToken Backslash <?> "lambda expression (e.g. \\x -> x)"
  args <- many1 funcParam <?> "lambda parameters"
  _ <- equalToken RightArrow
  e <- expressionParser
  pure (foldl (\e' arg -> LambdaExpression arg e') e (reverse args))

funcParam :: TokenParser Variable
funcParam = go <?> "function parameter (e.g. ‘x’, ‘limit’, etc.)"
  where
    go = do
      (v, _) <-
        consumeToken
          (\case
             VariableToken i -> Just i
             _ -> Nothing)
      pure (Variable v)