{-|
Module      : Control.Monad.Parse.Megaparsec
Description : MonadParse instance for Megaparsec
Copyright   : (c) Lackmann Phymetric
License     : GPL-3
Maintainer  : olaf.klinke@phymetric.de
Stability   : experimental

This module defines a 'MonadParse' and 'MonadParseIO' instances 
for the 'ParsecT' monad transformer from the megaparsec package. 

This module might be moved to a separate package in the future 
to make htconfig independent of megaparsec. 
-}
{-# LANGUAGE FlexibleInstances,FlexibleContexts,TypeFamilies #-}
module Control.Monad.Parse.Megaparsec where
import Control.Monad.Parse.Class
import Control.Monad.Except
import Data.List.NonEmpty
import Data.Functor.Identity
import Data.Configfile.Class (ParsableConfig(..))
import Text.Megaparsec
import Text.Megaparsec.Pos
import qualified Text.Megaparsec.Char as M

instance (Ord e, Stream s, Token s ~ Char, Tokens s ~ [Char]) => MonadParse (ParsecT e s m) where
    char   = M.char
    string = M.string
    anyOf  = M.satisfy
    eof    = Text.Megaparsec.eof
    try    = Text.Megaparsec.try

instance (Ord e, MonadIO m) => MonadParseIO (ParsecT e String m) where
    fromFile = inlineFile

-- | Parses the contents of the given file, restoring the previous parser state after parsing. 
inlineFile :: (MonadParsec e String m, MonadIO m) => m a -> FilePath -> m a
inlineFile p filename = do
    stateBeforeInlining <- getParserState
    filecontent <- liftIO (readFile filename)
    setParserState (State {
        stateInput = filecontent,
        statePos = (initialPos filename) :| [],
        stateTokensProcessed = 0,
        stateTabWidth = defaultTabWidth})
    x <- p
    setParserState stateBeforeInlining
    return x
{-- Comment on inlineFile:
One could use pushPosition (initialPos filename) and popPosition, 
but the statePos field in type State is due to change in megaparsec 7. 
Hence there is no way to make this future-proof. 
--}