content: {-# LANGUAGE PackageImports, ConstraintKinds, StandaloneDeriving,
               GeneralizedNewtypeDeriving, FlexibleInstances #-}
  module ParserCommon where
  
  import Text.Trifecta
  import Text.Trifecta.Delta
  import "indentation-trifecta" Text.Trifecta.Indentation
  
  import Text.Parser.Token as Tok
  import Text.Parser.Token.Style
  import qualified Text.Parser.Token.Highlight as Hi
  
  import Control.Applicative
  import Control.Monad
  
  import Data.Char
  import qualified Data.Map.Strict as M
  import qualified Data.HashSet as HashSet
  
  newtype FrankParser t m a =
    FrankParser { runFrankParser :: IndentationParserT t m a }
    deriving (Functor, Alternative, Applicative, Monad, Parsing
             , IndentationParsing, MonadPlus)
  
  deriving instance (DeltaParsing m) => (DeltaParsing (FrankParser Token m))
  deriving instance (DeltaParsing m) => (CharParsing (FrankParser Char m))
  deriving instance (DeltaParsing m) => (CharParsing (FrankParser Token m))
  deriving instance (DeltaParsing m) => (TokenParsing (FrankParser Char m))
  
  frankCommentStyle :: CommentStyle
  frankCommentStyle = CommentStyle "{--" "--}" "--" True
  
  instance DeltaParsing m => TokenParsing (FrankParser Token m) where
    someSpace = FrankParser $ buildSomeSpaceParser someSpace frankCommentStyle
    nesting = FrankParser . nesting . runFrankParser
    semi = FrankParser $ runFrankParser semi
    highlight h = FrankParser . highlight h . runFrankParser
    token p = (FrankParser $ token (runFrankParser p)) <* whiteSpace
  
  type MonadicParsing m = (TokenParsing m, IndentationParsing m, Monad m, DeltaParsing m)
  
  frankStyle :: MonadicParsing m => IdentifierStyle m
  frankStyle = IdentifierStyle {
      _styleName = "Frank"
    , _styleStart = satisfy (\c -> isAlpha c || c == '_')
    , _styleLetter = satisfy (\c -> isAlphaNum c || c == '_' || c == '\'')
    , _styleReserved = HashSet.fromList [ "data", "interface"
                                        , "let", "in"
                                        , "String", "Int", "Char"]
    , _styleHighlight = Hi.Identifier
    , _styleReservedHighlight = Hi.ReservedIdentifier }
  
  identifier :: MonadicParsing m => m String
  identifier = Tok.ident frankStyle
  
  reserved :: MonadicParsing m => String -> m ()
  reserved = Tok.reserve frankStyle
  