{-# 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] -- ^ Include path
             -> 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

-- | Parse an import. Does not perform renaming!
parseImport :: (MonadError (DickinsonError AlexPosn) m, MonadIO m)
            => [FilePath] -- ^ Include path
            -> Import AlexPosn
            -> AlexUserState -- ^ Lexer state
            -> 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 -- ^ Source file
        -> AlexUserState -- ^ Lexer state
        -> 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 -- ^ Source file
        -> 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 -- ^ Source file name (for error reporting)
        -> 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)