Parsable.hs

-- |
--
-- 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 = cata go where go (_ :< x) = embed 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 s = do
    (a, rest) <- parseNonGreedyWithLocation @a mode s
    unless (eof rest) . throwError . pure . Error.UnexpectedEndOfFile $ tokens rest
    pure a

  default parseNonGreedy :: (Recursive a, Corecursive a, MonadError (Errors s) m) => mode -> s -> m (a, s)
  parseNonGreedy mode = fmap (first unAnnotate) . parseNonGreedyWithLocation @a mode

  default parse :: (Recursive a, Corecursive a, MonadError (Errors s) m) => mode -> s -> m a
  parse mode = fmap unAnnotate . parseWithLocation @a mode