{-# LANGUAGE FlexibleContexts #-}
module Language.Dickinson.Rename.Amalgamate ( amalgamateM
, fileDecls
, bslDecls
) where
import Control.Composition ((<=*<))
import Control.Monad ((<=<))
import Control.Monad.Except (MonadError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.State (MonadState)
import qualified Data.ByteString.Lazy as BSL
import Data.Functor (($>))
import Data.Semigroup ((<>))
import Language.Dickinson.Check.Pattern
import Language.Dickinson.Error
import Language.Dickinson.Lexer
import Language.Dickinson.Lib.Get
import Language.Dickinson.Type
withImportM :: (HasLexerState s, MonadIO m, MonadError (DickinsonError AlexPosn) m, MonadState s m)
=> [FilePath]
-> Import AlexPosn
-> m [Declaration AlexPosn]
withImportM :: forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Import AlexPosn -> m [Declaration AlexPosn]
withImportM [FilePath]
is Import AlexPosn
i = do
Dickinson AlexPosn
dck <- forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
[FilePath] -> Import AlexPosn -> m (Dickinson AlexPosn)
parseImportM [FilePath]
is Import AlexPosn
i
forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Dickinson AlexPosn -> m [Declaration AlexPosn]
amalgamateM [FilePath]
is Dickinson AlexPosn
dck
amalgamateM :: (HasLexerState s, MonadIO m, MonadError (DickinsonError AlexPosn) m, MonadState s m)
=> [FilePath]
-> Dickinson AlexPosn
-> m [Declaration AlexPosn]
amalgamateM :: forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Dickinson AlexPosn -> m [Declaration AlexPosn]
amalgamateM [FilePath]
_ (Dickinson [] [Declaration AlexPosn]
ds) = forall e (m :: * -> *). MonadError e m => Maybe e -> m ()
maybeThrow (forall a. [Declaration a] -> Maybe (DickinsonError a)
checkPatternDecl [Declaration AlexPosn]
ds) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> [Declaration AlexPosn]
ds
amalgamateM [FilePath]
is (Dickinson [Import AlexPosn]
imps [Declaration AlexPosn]
ds) = do
[[Declaration AlexPosn]]
ids <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Import AlexPosn -> m [Declaration AlexPosn]
withImportM [FilePath]
is) [Import AlexPosn]
imps
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Declaration AlexPosn]]
ids forall a. Semigroup a => a -> a -> a
<> [Declaration AlexPosn]
ds)
fileDecls :: (HasLexerState s, MonadIO m, MonadError (DickinsonError AlexPosn) m, MonadState s m)
=> [FilePath]
-> FilePath
-> m [Declaration AlexPosn]
fileDecls :: forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> FilePath -> m [Declaration AlexPosn]
fileDecls [FilePath]
is = forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Dickinson AlexPosn -> m [Declaration AlexPosn]
amalgamateM [FilePath]
is forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m, MonadIO m) =>
FilePath -> m (Dickinson AlexPosn)
parseFpM
bslDecls :: (HasLexerState s, MonadIO m, MonadError (DickinsonError AlexPosn) m, MonadState s m)
=> [FilePath]
-> FilePath
-> BSL.ByteString
-> m [Declaration AlexPosn]
bslDecls :: forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> FilePath -> ByteString -> m [Declaration AlexPosn]
bslDecls [FilePath]
is = forall s (m :: * -> *).
(HasLexerState s, MonadIO m,
MonadError (DickinsonError AlexPosn) m, MonadState s m) =>
[FilePath] -> Dickinson AlexPosn -> m [Declaration AlexPosn]
amalgamateM [FilePath]
is forall (m :: * -> *) c d a b.
Monad m =>
(c -> m d) -> (a -> b -> m c) -> a -> b -> m d
<=*< forall s (m :: * -> *).
(HasLexerState s, MonadState s m,
MonadError (DickinsonError AlexPosn) m) =>
FilePath -> ByteString -> m (Dickinson AlexPosn)
parseBSLM