-- |
--
-- Module:      Language.Egison.Parser.Pattern.Parsable
-- Description: Type class providing functions for parsing
-- Stability:   experimental
--
-- This module provides a type class for parsing many types.

{-# LANGUAGE AllowAmbiguousTypes #-}

module Language.Egison.Parser.Pattern.Parsable
  ( Parsable(..)
  )
where

import           Control.Monad                  ( unless )
import           Control.Monad.Except           ( MonadError(..) )
import           Data.Bifunctor                 ( first )
import           Control.Comonad.Cofree         ( Cofree )
import           Control.Comonad.Trans.Cofree   ( CofreeF(..) )
import           Data.Functor.Foldable          ( Base
                                                , Recursive(..)
                                                , Corecursive(..)
                                                )

import           Language.Egison.Parser.Pattern.Prim.Location
                                                ( Location )
import           Language.Egison.Parser.Pattern.Prim.Source
                                                ( Source(..) )
import           Language.Egison.Parser.Pattern.Prim.Error
                                                ( Errors )
import qualified Language.Egison.Parser.Pattern.Prim.Error
                                               as Error
                                                ( Error(..) )


unAnnotate :: (Recursive x, Corecursive x) => Cofree (Base x) a -> x
unAnnotate :: Cofree (Base x) a -> x
unAnnotate = (Base (Cofree (Base x) a) x -> x) -> Cofree (Base x) a -> x
forall t a. Recursive t => (Base t a -> a) -> t -> a
cata Base (Cofree (Base x) a) x -> x
forall t a. Corecursive t => CofreeF (Base t) a t -> t
go where go :: CofreeF (Base t) a t -> t
go (a
_ :< Base t t
x) = Base t t -> t
forall t. Corecursive t => Base t t -> t
embed Base t t
x

-- | Type class providing functions for parsing.
class Source s => Parsable a s mode where
  -- | Parse a source stream.
  parse :: MonadError (Errors s) m => mode -> s -> m a
  -- | Parse a source stream with location annotations.
  parseWithLocation :: MonadError (Errors s) m => mode -> s -> m (Cofree (Base a) Location)
  -- | Parse a source stream non-greedily. That is, this parser will only consume the input until a is fully parsed, and return the rest of the input.
  parseNonGreedy :: MonadError (Errors s) m => mode -> s -> m (a, s)
  -- | Parse a source stream non-greedily with location annotations.
  parseNonGreedyWithLocation :: MonadError (Errors s) m => mode -> s -> m (Cofree (Base a) Location, s)

  parseWithLocation mode
mode s
s = do
    (Cofree (Base a) Location
a, s
rest) <- mode -> s -> m (Cofree (Base a) Location, s)
forall a s mode (m :: * -> *).
(Parsable a s mode, MonadError (Errors s) m) =>
mode -> s -> m (Cofree (Base a) Location, s)
parseNonGreedyWithLocation @a mode
mode s
s
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (s -> Bool
forall s. Source s => s -> Bool
eof s
rest) (m () -> m ()) -> (Tokens s -> m ()) -> Tokens s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Errors s -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Errors s -> m ()) -> (Tokens s -> Errors s) -> Tokens s -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error s -> Errors s
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Error s -> Errors s)
-> (Tokens s -> Error s) -> Tokens s -> Errors s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tokens s -> Error s
forall s. Tokens s -> Error s
Error.UnexpectedEndOfFile (Tokens s -> m ()) -> Tokens s -> m ()
forall a b. (a -> b) -> a -> b
$ s -> Tokens s
forall s. Source s => s -> Tokens s
tokens s
rest
    Cofree (Base a) Location -> m (Cofree (Base a) Location)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cofree (Base a) Location
a

  default parseNonGreedy :: (Recursive a, Corecursive a, MonadError (Errors s) m) => mode -> s -> m (a, s)
  parseNonGreedy mode
mode = ((Cofree (Base a) Location, s) -> (a, s))
-> m (Cofree (Base a) Location, s) -> m (a, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Cofree (Base a) Location -> a)
-> (Cofree (Base a) Location, s) -> (a, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Cofree (Base a) Location -> a
forall x a. (Recursive x, Corecursive x) => Cofree (Base x) a -> x
unAnnotate) (m (Cofree (Base a) Location, s) -> m (a, s))
-> (s -> m (Cofree (Base a) Location, s)) -> s -> m (a, s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. mode -> s -> m (Cofree (Base a) Location, s)
forall a s mode (m :: * -> *).
(Parsable a s mode, MonadError (Errors s) m) =>
mode -> s -> m (Cofree (Base a) Location, s)
parseNonGreedyWithLocation @a mode
mode

  default parse :: (Recursive a, Corecursive a, MonadError (Errors s) m) => mode -> s -> m a
  parse mode
mode = (Cofree (Base a) Location -> a)
-> m (Cofree (Base a) Location) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cofree (Base a) Location -> a
forall x a. (Recursive x, Corecursive x) => Cofree (Base x) a -> x
unAnnotate (m (Cofree (Base a) Location) -> m a)
-> (s -> m (Cofree (Base a) Location)) -> s -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. mode -> s -> m (Cofree (Base a) Location)
forall a s mode (m :: * -> *).
(Parsable a s mode, MonadError (Errors s) m) =>
mode -> s -> m (Cofree (Base a) Location)
parseWithLocation @a mode
mode