{-# LANGUAGE FlexibleContexts #-}
module Require.Transform where
import Control.Monad.Except
import Control.Monad.Writer.Strict
import Data.DList (DList)
import qualified Data.Text as Text
import Relude
import Require.Error (Error(..))
import qualified Require.File as File
import qualified Require.Parser as Parser
import Require.Types
type TransformM =
StateT TransformState
(WriterT (DList Text)
(Either Error))
data TransformState = TransformState
{ TransformState -> LineTag -> TransformM ()
tstLineTagOutput :: File.LineTag -> TransformM ()
, TransformState -> Maybe ModuleName
tstHostModule :: !(Maybe ModuleName)
, TransformState -> AutorequireMode Input
tstAutorequire :: !(AutorequireMode File.Input)
}
output :: Text -> TransformM ()
output :: Text -> TransformM ()
output = DList Text -> TransformM ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (DList Text -> TransformM ())
-> (Text -> DList Text) -> Text -> TransformM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DList Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure
renderLineTag :: File.LineTag -> TransformM ()
renderLineTag :: LineTag -> TransformM ()
renderLineTag (File.LineTag (File.Name Text
fn) (File.LineNumber Int
ln)) =
Text -> TransformM ()
output (Text -> TransformM ()) -> Text -> TransformM ()
forall a b. (a -> b) -> a -> b
$ Text
"{-# LINE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show Int
ln Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\" #-}"
ignoreLineTag :: File.LineTag -> TransformM ()
ignoreLineTag :: LineTag -> TransformM ()
ignoreLineTag = TransformM () -> LineTag -> TransformM ()
forall a b. a -> b -> a
const (() -> TransformM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
transform :: AutorequireMode File.Input -> File.Input -> Either Error [Text]
transform :: AutorequireMode Input -> Input -> Either Error [Text]
transform AutorequireMode Input
autorequire Input
input =
Input -> [(LineTag, Text)]
File.inputLines Input
input
[(LineTag, Text)]
-> ([(LineTag, Text)] -> TransformM ()) -> TransformM ()
forall a b. a -> (a -> b) -> b
& ((LineTag, Text) -> TransformM ())
-> [(LineTag, Text)] -> TransformM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> (LineTag, Text) -> TransformM ()
process Bool
False)
TransformM ()
-> (TransformM ()
-> WriterT (DList Text) (Either Error) TransformState)
-> WriterT (DList Text) (Either Error) TransformState
forall a b. a -> (a -> b) -> b
& (TransformM ()
-> TransformState
-> WriterT (DList Text) (Either Error) TransformState)
-> TransformState
-> TransformM ()
-> WriterT (DList Text) (Either Error) TransformState
forall a b c. (a -> b -> c) -> b -> a -> c
flip TransformM ()
-> TransformState
-> WriterT (DList Text) (Either Error) TransformState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT TransformState
initialState
WriterT (DList Text) (Either Error) TransformState
-> (WriterT (DList Text) (Either Error) TransformState
-> WriterT (DList Text) (Either Error) ())
-> WriterT (DList Text) (Either Error) ()
forall a b. a -> (a -> b) -> b
& (TransformState -> WriterT (DList Text) (Either Error) ())
-> WriterT (DList Text) (Either Error) TransformState
-> WriterT (DList Text) (Either Error) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
chainedTo TransformState -> WriterT (DList Text) (Either Error) ()
forall (m :: * -> *). MonadError Error m => TransformState -> m ()
checkDidAutorequire
WriterT (DList Text) (Either Error) ()
-> (WriterT (DList Text) (Either Error) ()
-> Either Error (DList Text))
-> Either Error (DList Text)
forall a b. a -> (a -> b) -> b
& WriterT (DList Text) (Either Error) () -> Either Error (DList Text)
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT
Either Error (DList Text)
-> (Either Error (DList Text) -> Either Error [Text])
-> Either Error [Text]
forall a b. a -> (a -> b) -> b
& (DList Text -> [Text])
-> Either Error (DList Text) -> Either Error [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DList Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
where
initialState :: TransformState
initialState = TransformState :: (LineTag -> TransformM ())
-> Maybe ModuleName -> AutorequireMode Input -> TransformState
TransformState
{ tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
renderLineTag
, tstHostModule :: Maybe ModuleName
tstHostModule = Maybe ModuleName
forall a. Maybe a
Nothing
, tstAutorequire :: AutorequireMode Input
tstAutorequire = AutorequireMode Input
autorequire
}
unableToAutorequire :: TransformState -> Bool
unableToAutorequire TransformState
resultState
| AutorequireEnabled Input
_ <- AutorequireMode Input
autorequire
, AutorequireEnabled Input
_ <- TransformState -> AutorequireMode Input
tstAutorequire TransformState
resultState
= Bool
True
| Bool
otherwise
= Bool
False
checkDidAutorequire :: TransformState -> m ()
checkDidAutorequire TransformState
resultState
| TransformState -> Bool
unableToAutorequire TransformState
resultState = Error -> m ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
AutorequireImpossible
| Bool
otherwise = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
process :: Bool -> (File.LineTag, Text) -> TransformM ()
process :: Bool -> (LineTag, Text) -> TransformM ()
process Bool
filterImports (LineTag
tag, Text
line) = do
let useTagPrep :: TransformM ()
useTagPrep = do
TransformState
tst <- StateT
TransformState (WriterT (DList Text) (Either Error)) TransformState
forall s (m :: * -> *). MonadState s m => m s
get
TransformState -> LineTag -> TransformM ()
tstLineTagOutput TransformState
tst LineTag
tag
TransformState -> TransformM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TransformState
tst { tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
ignoreLineTag })
let lineWithAutorequire :: Bool -> Bool -> TransformM ()
lineWithAutorequire Bool
isDirective Bool
autoCondition = do
AutorequireMode Input
autoMode <- (TransformState -> AutorequireMode Input)
-> StateT
TransformState
(WriterT (DList Text) (Either Error))
(AutorequireMode Input)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TransformState -> AutorequireMode Input
tstAutorequire
case AutorequireMode Input
autoMode of
AutorequireEnabled Input
autoContent
| Bool
isDirective Bool -> Bool -> Bool
|| Bool
autoCondition -> do
Bool -> TransformM () -> TransformM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
isDirective (TransformM ()
useTagPrep TransformM () -> TransformM () -> TransformM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> TransformM ()
output Text
line)
Input -> TransformM ()
processAutorequireContent Input
autoContent
AutorequireOnDirective (Just Input
autoContent)
| Bool
isDirective -> Input -> TransformM ()
processAutorequireContent Input
autoContent
AutorequireOnDirective Maybe Input
Nothing
| Bool
isDirective -> Error -> TransformM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError Error
MissingOptionalRequiresFile
AutorequireMode Input
_ | Bool
isDirective -> () -> TransformM ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> TransformM ()
useTagPrep TransformM () -> TransformM () -> TransformM ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> TransformM ()
output Text
line
let hasWhere :: Bool
hasWhere =
Text -> [Text]
forall t. IsText t "words" => t -> [t]
words Text
line
[Text] -> ([Text] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
"--" Text -> Text -> Bool
`Text.isPrefixOf`))
[Text] -> ([Text] -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Text -> [Text] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
elem Text
"where"
case Parsec Void Text RequireDirective -> Text -> Maybe RequireDirective
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Parser.parseMaybe Parsec Void Text RequireDirective
Parser.requireDirective Text
line of
Maybe RequireDirective
Nothing -> do
Bool
hasModule <- (TransformState -> Bool)
-> StateT TransformState (WriterT (DList Text) (Either Error)) Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ((TransformState -> Bool)
-> StateT
TransformState (WriterT (DList Text) (Either Error)) Bool)
-> (TransformState -> Bool)
-> StateT TransformState (WriterT (DList Text) (Either Error)) Bool
forall a b. (a -> b) -> a -> b
$ Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ModuleName -> Bool)
-> (TransformState -> Maybe ModuleName) -> TransformState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TransformState -> Maybe ModuleName
tstHostModule
Bool -> Bool -> TransformM ()
lineWithAutorequire Bool
False (Bool -> TransformM ()) -> Bool -> TransformM ()
forall a b. (a -> b) -> a -> b
$ Bool
hasModule Bool -> Bool -> Bool
&& Bool
hasWhere
Just (ModuleDirective ModuleName
moduleName) -> do
(TransformState -> TransformState) -> TransformM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TransformState -> TransformState) -> TransformM ())
-> (TransformState -> TransformState) -> TransformM ()
forall a b. (a -> b) -> a -> b
$ \TransformState
s -> TransformState
s { tstHostModule :: Maybe ModuleName
tstHostModule = TransformState -> Maybe ModuleName
tstHostModule TransformState
s Maybe ModuleName -> Maybe ModuleName -> Maybe ModuleName
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
moduleName }
Bool -> Bool -> TransformM ()
lineWithAutorequire Bool
False Bool
hasWhere
Just (RequireDirective RequireInfo
ri) ->
Bool -> LineTag -> RequireInfo -> TransformM ()
renderImport Bool
filterImports LineTag
tag RequireInfo
ri
Just RequireDirective
AutorequireDirective ->
Bool -> Bool -> TransformM ()
lineWithAutorequire Bool
True Bool
False
processAutorequireContent :: File.Input -> TransformM ()
processAutorequireContent :: Input -> TransformM ()
processAutorequireContent Input
autorequireContent = do
(TransformState -> TransformState) -> TransformM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TransformState -> TransformState) -> TransformM ())
-> (TransformState -> TransformState) -> TransformM ()
forall a b. (a -> b) -> a -> b
$ \TransformState
s -> TransformState
s
{ tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
renderLineTag
, tstAutorequire :: AutorequireMode Input
tstAutorequire = AutorequireMode Input
forall a. AutorequireMode a
AutorequireDisabled
}
((LineTag, Text) -> TransformM ())
-> [(LineTag, Text)] -> TransformM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> (LineTag, Text) -> TransformM ()
process Bool
True) (Input -> [(LineTag, Text)]
File.inputLines Input
autorequireContent)
(TransformState -> TransformState) -> TransformM ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((TransformState -> TransformState) -> TransformM ())
-> (TransformState -> TransformState) -> TransformM ()
forall a b. (a -> b) -> a -> b
$ \TransformState
s -> TransformState
s { tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
renderLineTag }
renderImport :: Bool -> File.LineTag -> RequireInfo -> TransformM ()
renderImport :: Bool -> LineTag -> RequireInfo -> TransformM ()
renderImport Bool
filterImports LineTag
line RequireInfo {Text
ModuleName
riImportedTypes :: RequireInfo -> Text
riModuleAlias :: RequireInfo -> Text
riFullModuleName :: RequireInfo -> ModuleName
riImportedTypes :: Text
riModuleAlias :: Text
riFullModuleName :: ModuleName
..} = do
TransformState
tst <- StateT
TransformState (WriterT (DList Text) (Either Error)) TransformState
forall s (m :: * -> *). MonadState s m => m s
get
if Bool
filterImports Bool -> Bool -> Bool
&& TransformState -> Maybe ModuleName
tstHostModule TransformState
tst Maybe ModuleName -> Maybe ModuleName -> Bool
forall a. Eq a => a -> a -> Bool
== ModuleName -> Maybe ModuleName
forall a. a -> Maybe a
Just ModuleName
riFullModuleName
then
TransformState -> TransformM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TransformState
tst { tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
renderLineTag })
else do
TransformState -> LineTag -> TransformM ()
tstLineTagOutput TransformState
tst LineTag
line
Text -> TransformM ()
output Text
typesImport
LineTag -> TransformM ()
renderLineTag LineTag
line
Text -> TransformM ()
output Text
qualifiedImport
TransformState -> TransformM ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (TransformState
tst { tstLineTagOutput :: LineTag -> TransformM ()
tstLineTagOutput = LineTag -> TransformM ()
ignoreLineTag })
where
typesImport :: Text
typesImport = [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords
[ Text
"import"
, ModuleName -> Text
unModuleName ModuleName
riFullModuleName
, Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
riImportedTypes Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
]
qualifiedImport :: Text
qualifiedImport = [Text] -> Text
forall t. IsText t "unwords" => [t] -> t
unwords
[ Text
"import qualified"
, ModuleName -> Text
unModuleName ModuleName
riFullModuleName
, Text
"as"
, Text
riModuleAlias
]