{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP                 #-}

-- |
--
-- Module:      Language.Egison.Parser.Pattern.Prim.Source
-- Description: Constraint for the source of parser
-- Stability:   experimental
--
-- A constraint and property of the source of parser

module Language.Egison.Parser.Pattern.Prim.Source
  ( Source(..)
  , Token
  , Tokens
  )
where

import           Data.Text                      ( Text )
import qualified Data.Text                     as T
                                                ( null
                                                , cons
                                                , snoc
                                                )
import qualified Text.Megaparsec               as Parsec
                                                ( Stream(..)
#if MIN_VERSION_megaparsec(9,0,0)
                                                , TraversableStream(..)
#endif
                                                )

import           Language.Egison.Parser.Pattern.Token
                                                ( IsToken )


-- | Type of token in the source.
type Token s = Parsec.Token s
-- | Type of tokens in the source.
type Tokens s = Parsec.Tokens s


-- | Constraint for the source of parser.
-- TODO: Hide these methods in haddock (see haskell/haddock#330)
#if MIN_VERSION_megaparsec(9,0,0)
class (Parsec.TraversableStream s, IsToken (Token s)) => Source s where
#else
class (Parsec.Stream s, IsToken (Token s)) => Source s where
#endif
  -- | Check if the stream is null or not.
  eof :: s -> Bool
  -- | Reify the input stream into a chunk of tokens.
  tokens :: s -> Tokens s
  -- | Add a token to the front of a chunk.
  consTokens :: Token s -> Tokens s -> Tokens s
  -- | Add a token to the back of a chunk.
  snocTokens :: Tokens s -> Token s -> Tokens s

instance Source Text where
  eof :: Text -> Bool
eof        = Text -> Bool
T.null
  tokens :: Text -> Tokens Text
tokens     = Text -> Tokens Text
forall a. a -> a
id
  consTokens :: Token Text -> Tokens Text -> Tokens Text
consTokens = Char -> Text -> Text
Token Text -> Tokens Text -> Tokens Text
T.cons
  snocTokens :: Tokens Text -> Token Text -> Tokens Text
snocTokens = Text -> Char -> Text
Tokens Text -> Token Text -> Tokens Text
T.snoc

instance Source String where
  eof :: String -> Bool
eof        = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null
  tokens :: String -> Tokens String
tokens     = String -> Tokens String
forall a. a -> a
id
  consTokens :: Token String -> Tokens String -> Tokens String
consTokens = (:)
  snocTokens :: Tokens String -> Token String -> Tokens String
snocTokens Tokens String
xs Token String
x = String
Tokens String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
Token String
x]