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

-- sequence?
amalgamateM :: (HasLexerState s, MonadIO m, MonadError (DickinsonError AlexPosn) m, MonadState s m)
            => [FilePath] -- ^ Includes
            -> 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] -- ^ Includes
          -> FilePath -- ^ Source file
          -> 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] -- ^ Includes
          -> FilePath -- ^ Source file (for reporting errors)
          -> 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