{-# LANGUAGE FlexibleContexts #-}
module Language.Dickinson.Lib.Get ( parseImportM
, parseFpM
, parseBSLM
) where
import Control.Composition ((.*))
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.State (MonadState)
import qualified Data.ByteString.Lazy as BSL
import Data.Functor (($>))
import Language.Dickinson.Error
import Language.Dickinson.Import
import Language.Dickinson.Lexer
import Language.Dickinson.Parser
import Language.Dickinson.Type
import Lens.Micro.Mtl (use, (.=))
parseImportM :: (HasLexerState s, MonadState s m, MonadError (DickinsonError AlexPosn) m, MonadIO m)
=> [FilePath]
-> Import AlexPosn
-> m (Dickinson AlexPosn)
parseImportM :: forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
[FilePath] -> Import AlexPosn -> m (Dickinson AlexPosn)
parseImportM = forall s (m :: * -> *) a.
(HasLexerState s, MonadState s m) =>
(AlexUserState -> m (AlexUserState, a)) -> m a
liftLexerState forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* forall (m :: * -> *).
(MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
[FilePath]
-> Import AlexPosn
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseImport
liftLexerState :: (HasLexerState s, MonadState s m)
=> (AlexUserState -> m (AlexUserState, a))
-> m a
liftLexerState :: forall s (m :: * -> *) a.
(HasLexerState s, MonadState s m) =>
(AlexUserState -> m (AlexUserState, a)) -> m a
liftLexerState AlexUserState -> m (AlexUserState, a)
fAct = do
AlexUserState
lSt <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use forall a. HasLexerState a => Lens' a AlexUserState
lexerStateLens
(AlexUserState
st, a
x) <- AlexUserState -> m (AlexUserState, a)
fAct AlexUserState
lSt
(forall a. HasLexerState a => Lens' a AlexUserState
lexerStateLens forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= AlexUserState
st) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> a
x
parseImport :: (MonadError (DickinsonError AlexPosn) m, MonadIO m)
=> [FilePath]
-> Import AlexPosn
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseImport :: forall (m :: * -> *).
(MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
[FilePath]
-> Import AlexPosn
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseImport [FilePath]
is (Import AlexPosn
l Name AlexPosn
n) AlexUserState
lSt = do
Maybe FilePath
preFp <- forall (m :: * -> *) a.
MonadIO m =>
[FilePath] -> Name a -> m (Maybe FilePath)
resolveImport [FilePath]
is Name AlexPosn
n
case Maybe FilePath
preFp of
Just FilePath
fp -> forall (m :: * -> *).
(MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
FilePath -> AlexUserState -> m (AlexUserState, Dickinson AlexPosn)
parseFp FilePath
fp AlexUserState
lSt
Maybe FilePath
Nothing -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ forall a. a -> Name a -> DickinsonError a
ModuleNotFound AlexPosn
l Name AlexPosn
n
parseBSL :: (MonadError (DickinsonError AlexPosn) m)
=> FilePath
-> BSL.ByteString
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseBSL :: forall (m :: * -> *).
MonadError (DickinsonError AlexPosn) m =>
FilePath
-> ByteString
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseBSL FilePath
fp ByteString
bsl AlexUserState
lSt =
case ByteString
-> AlexUserState
-> Either (ParseError AlexPosn) (AlexUserState, Dickinson AlexPosn)
parseWithCtx ByteString
bsl AlexUserState
lSt of
Right (AlexUserState, Dickinson AlexPosn)
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (AlexUserState, Dickinson AlexPosn)
x
Left ParseError AlexPosn
err -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (forall a. FilePath -> ParseError a -> DickinsonError a
ParseErr FilePath
fp ParseError AlexPosn
err)
parseFp :: (MonadError (DickinsonError AlexPosn) m, MonadIO m)
=> FilePath
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseFp :: forall (m :: * -> *).
(MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
FilePath -> AlexUserState -> m (AlexUserState, Dickinson AlexPosn)
parseFp FilePath
fp AlexUserState
lSt = do
ByteString
bsl <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BSL.readFile FilePath
fp
forall (m :: * -> *).
MonadError (DickinsonError AlexPosn) m =>
FilePath
-> ByteString
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseBSL FilePath
fp ByteString
bsl AlexUserState
lSt
parseFpM :: (HasLexerState s, MonadState s m, MonadError (DickinsonError AlexPosn) m, MonadIO m)
=> FilePath
-> m (Dickinson AlexPosn)
parseFpM :: forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
FilePath -> m (Dickinson AlexPosn)
parseFpM FilePath
fp = forall s (m :: * -> *) a.
(HasLexerState s, MonadState s m) =>
(AlexUserState -> m (AlexUserState, a)) -> m a
liftLexerState (forall (m :: * -> *).
(MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
FilePath -> AlexUserState -> m (AlexUserState, Dickinson AlexPosn)
parseFp FilePath
fp)
parseBSLM :: (HasLexerState s, MonadState s m, MonadError (DickinsonError AlexPosn) m)
=> FilePath
-> BSL.ByteString
-> m (Dickinson AlexPosn)
parseBSLM :: forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m) =>
FilePath -> ByteString -> m (Dickinson AlexPosn)
parseBSLM FilePath
fp ByteString
bsl = forall s (m :: * -> *) a.
(HasLexerState s, MonadState s m) =>
(AlexUserState -> m (AlexUserState, a)) -> m a
liftLexerState (forall (m :: * -> *).
MonadError (DickinsonError AlexPosn) m =>
FilePath
-> ByteString
-> AlexUserState
-> m (AlexUserState, Dickinson AlexPosn)
parseBSL FilePath
fp ByteString
bsl)