module GenericParser.Parser where
import Prelude

import Control.Alt (class Alt, (<|>))
import Control.Alternative (class Alternative)
import Control.Lazy (class Lazy)
import Control.Plus (class Plus, empty)
import Data.Array as A
import Data.Either (Either(..))
import Data.Int as Int
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits (toCharArray, fromCharArray)

import GenericParser.BaseFunctions (concat, isAlpha, isAlphaNum, isDigit, isLower, isSpace, isUpper)

type Position = Int
type PositionString = { string :: String, position :: Position }
type Input = PositionString

type Error e = { position :: Position, error :: Maybe e }
type Value v = { result :: v, suffix :: Input }
type Result e v = Either (Error e) (Value v)

newtype Parser e v = Parser (Input -> Result e v)
--newtype Parser v = Parser (String -> Maybe (Tuple v String))
parse :: forall e v. Parser e v -> (Input -> Result e v)
parse (Parser p) = p

current_position :: forall e. Parser e Position
current_position = Parser \input -> success input input.position

-- | Fail with a specified error.
-- | When a parsing has a specified error, no alternative will be tried and the error is reported.
failureError :: forall e v. Position -> Maybe e -> Result e v
failureError position error = Left { position, error }

-- | Fail without a specified error.
-- | This is used in generic parsers not attached to a specified context,
-- | such as `digit` or `letter`.
-- | Also, this can be used to express a possibly expected invalid parsing that should not
-- | halt the parsing, but rather let an alternative path to be tried.
failure :: forall e v. Position -> Result e v
failure position = failureError position Nothing

-- | `success` constructs a result value for a successful parsing.
-- | It requires the input (a string with its current position) and the result.
success :: forall e v. Input -> v -> Result e v
success suffix result = Right { suffix, result }

-- | Read a single char from the input.
item :: forall e. Parser e Char
item = Parser p
  where
    p input = case A.uncons (toCharArray input.string) of
      Nothing                    -> failure input.position
      Just { head: x, tail: xs } -> success { string: (fromCharArray xs), position: input.position+1 } x

instance functorParser :: Functor (Parser e) where
  map :: forall a b. (a -> b) -> Parser e a -> Parser e b
  map f (Parser p) =
    Parser $ \s0 -> case p s0 of
      Right { suffix, result } -> success suffix (f result)
      Left error               -> Left error

instance applyParser :: Apply (Parser e) where
  apply (Parser p1) (Parser p2)
    = Parser $ \s0 -> case p1 s0 of
        Right { suffix: suffix1, result: result1 } -> case p2 suffix1 of
          Right { suffix: suffix2, result: result2 } -> success suffix2 (result1 result2)
          Left error -> Left error
        Left error -> Left error

instance applicativeParser :: Applicative (Parser e) where
  pure a = Parser $ \input -> success input a

instance bindParser :: Bind (Parser e) where
  bind (Parser p) f = Parser $ \s0 -> case p s0 of
    Right { suffix, result } -> parse (f result) suffix
    Left error               -> Left error

-- | `Alt` instance: in case of an error that produced an error value, the computation stops.
instance altParser :: Alt (Parser e) where
  alt :: forall v. Parser e v -> Parser e v -> Parser e v
  alt (Parser p1) (Parser p2) = Parser p
    where
      p stream = case p1 stream of
        Left { position, error } -> case error of
          Nothing -> p2 stream
          _       -> failureError position error
        Right right -> Right right

instance plusParser :: Plus (Parser e) where
  empty :: forall v. Parser e v
  empty = Parser \input -> failure input.position

instance alternativeParser :: Alternative (Parser e)

instance lazyParser :: Lazy (Parser e v) where
  defer f = Parser \input -> parse (f unit) input

-- Generic parsing functions.

-- | `tryMaybe` provides a way to accept a faulty parser and
-- | just rewinds back to previous input state if an error occurs.
tryMaybe :: forall e a. Parser e a -> Parser e (Maybe a)
tryMaybe p = Parser p'
  where p' input = case parse p input of
                   Left _                   -> success input Nothing
                   Right { suffix, result } -> success suffix (Just result)

-- | `try` provides a way to accept a faulty parser and
-- | just rewinds back to previous input state if a non-specific error occurs.
-- | The difference with `tryMaybe` is that `try` will forward the error if it is
-- | a specific one, meaning that `error` isn't `Nothing`.
try :: forall e a. Parser e a -> Parser e (Maybe a)
try p = Parser p'
  where p' input = case parse p input of
                   Right { suffix, result } -> success suffix (Just result)
                   Left { position, error } -> case error of
                     Nothing -> success input Nothing
                     _       -> failureError position error

sat :: forall e. (Char -> Boolean) -> Parser e Char
sat p = do
           pos <- current_position
           x <- item
           if p x then pure x else Parser \input -> failure pos

digit :: forall e. Parser e Char
digit = sat isDigit

lower :: forall e. Parser e Char
lower = sat isLower

upper :: forall e. Parser e Char
upper = sat isUpper

letter :: forall e. Parser e Char
letter = sat isAlpha

alphanum :: forall e. Parser e Char
alphanum = sat isAlphaNum

char :: forall e. Char -> Parser e Char
char x = sat (_ == x)

string :: forall e. String -> Parser e String
string str = case A.uncons (toCharArray str) of
  Nothing -> Parser \input -> success input ""
  Just { head: x, tail: xs } -> do c <- char x
                                   rest <- string (fromCharArray xs)
                                   pure (concat c rest)

ident :: forall e. Parser e String
ident = do x  <- lower
           xs <- A.many alphanum
           pure (fromCharArray $ A.cons x xs)

nat :: forall e. Parser e Int
nat = do xs <- A.some digit
         case Int.fromString (fromCharArray xs) of
           Nothing -> empty
           Just x -> pure x

int :: forall e. Parser e Int
int = do _ <- char '-'
         n <- nat
         pure (-n)
       <|> nat

space :: forall e. Parser e Unit
space = do _ <- A.many (sat isSpace)
           pure unit

token :: forall e a. Parser e a -> Parser e a
token p = do space
             v <- p
             _ <- space
             pure v

identifier :: forall e. Parser e String
identifier = token ident

natural :: forall e. Parser e Int
natural = token nat

integer :: forall e. Parser e Int
integer = token int

symbol :: forall e. String -> Parser e String
symbol xs = token (string xs)

many1 :: forall e v. Parser e v -> Parser e (Array v)
many1 p = do first <- p
             rest <- A.many p
             pure $ A.cons first rest