{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Utility functions based on 'Data.Text.Template' to offer @ $var @ variable
--    expansion in string throughout a B9 artifact.
--
--    @deprecated
--
--    TODO remove this in the move to Dhall
module B9.Artifact.Content.StringTemplate
  ( subst,
    substStr,
    substFile,
    substPath,
    readTemplateFile,
    withSubstitutedStringBindings,
    SourceFile (..),
    SourceFileConversion (..),
  )
where

import B9.B9Error
import B9.Environment
import B9.QCUtil
import Control.Eff as Eff
import Control.Exception (displayException)
import Control.Monad (foldM)
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Identity ()
import Control.Parallel.Strategies
import Data.Binary
import Data.Data
import Data.Hashable
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Lazy as LazyText
  ( toStrict,
  )
import Data.Text.Template
  ( Template,
    renderA,
    templateSafe,
  )
import GHC.Generics (Generic)
import System.IO.B9Extras
import Test.QuickCheck
import Text.Printf

-- | A wrapper around a file path and a flag indicating if template variable
-- expansion should be performed when reading the file contents.
data SourceFile
  = Source
      SourceFileConversion
      FilePath
  deriving (ReadPrec [SourceFile]
ReadPrec SourceFile
Int -> ReadS SourceFile
ReadS [SourceFile]
(Int -> ReadS SourceFile)
-> ReadS [SourceFile]
-> ReadPrec SourceFile
-> ReadPrec [SourceFile]
-> Read SourceFile
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceFile]
$creadListPrec :: ReadPrec [SourceFile]
readPrec :: ReadPrec SourceFile
$creadPrec :: ReadPrec SourceFile
readList :: ReadS [SourceFile]
$creadList :: ReadS [SourceFile]
readsPrec :: Int -> ReadS SourceFile
$creadsPrec :: Int -> ReadS SourceFile
Read, Int -> SourceFile -> ShowS
[SourceFile] -> ShowS
SourceFile -> String
(Int -> SourceFile -> ShowS)
-> (SourceFile -> String)
-> ([SourceFile] -> ShowS)
-> Show SourceFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceFile] -> ShowS
$cshowList :: [SourceFile] -> ShowS
show :: SourceFile -> String
$cshow :: SourceFile -> String
showsPrec :: Int -> SourceFile -> ShowS
$cshowsPrec :: Int -> SourceFile -> ShowS
Show, Typeable, Typeable SourceFile
DataType
Constr
Typeable SourceFile
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SourceFile -> c SourceFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceFile)
-> (SourceFile -> Constr)
-> (SourceFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceFile))
-> ((forall b. Data b => b -> b) -> SourceFile -> SourceFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> SourceFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile)
-> Data SourceFile
SourceFile -> DataType
SourceFile -> Constr
(forall b. Data b => b -> b) -> SourceFile -> SourceFile
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFile -> c SourceFile
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFile
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> SourceFile -> u
forall u. (forall d. Data d => d -> u) -> SourceFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFile -> c SourceFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceFile)
$cSource :: Constr
$tSourceFile :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
gmapMp :: (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
gmapM :: (forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> SourceFile -> m SourceFile
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> SourceFile -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SourceFile -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFile -> r
gmapT :: (forall b. Data b => b -> b) -> SourceFile -> SourceFile
$cgmapT :: (forall b. Data b => b -> b) -> SourceFile -> SourceFile
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c SourceFile)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFile)
dataTypeOf :: SourceFile -> DataType
$cdataTypeOf :: SourceFile -> DataType
toConstr :: SourceFile -> Constr
$ctoConstr :: SourceFile -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFile
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFile -> c SourceFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SourceFile -> c SourceFile
$cp1Data :: Typeable SourceFile
Data, SourceFile -> SourceFile -> Bool
(SourceFile -> SourceFile -> Bool)
-> (SourceFile -> SourceFile -> Bool) -> Eq SourceFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceFile -> SourceFile -> Bool
$c/= :: SourceFile -> SourceFile -> Bool
== :: SourceFile -> SourceFile -> Bool
$c== :: SourceFile -> SourceFile -> Bool
Eq, (forall x. SourceFile -> Rep SourceFile x)
-> (forall x. Rep SourceFile x -> SourceFile) -> Generic SourceFile
forall x. Rep SourceFile x -> SourceFile
forall x. SourceFile -> Rep SourceFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceFile x -> SourceFile
$cfrom :: forall x. SourceFile -> Rep SourceFile x
Generic)

instance Hashable SourceFile

instance Binary SourceFile

instance NFData SourceFile

data SourceFileConversion
  = NoConversion
  | ExpandVariables
  deriving (ReadPrec [SourceFileConversion]
ReadPrec SourceFileConversion
Int -> ReadS SourceFileConversion
ReadS [SourceFileConversion]
(Int -> ReadS SourceFileConversion)
-> ReadS [SourceFileConversion]
-> ReadPrec SourceFileConversion
-> ReadPrec [SourceFileConversion]
-> Read SourceFileConversion
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceFileConversion]
$creadListPrec :: ReadPrec [SourceFileConversion]
readPrec :: ReadPrec SourceFileConversion
$creadPrec :: ReadPrec SourceFileConversion
readList :: ReadS [SourceFileConversion]
$creadList :: ReadS [SourceFileConversion]
readsPrec :: Int -> ReadS SourceFileConversion
$creadsPrec :: Int -> ReadS SourceFileConversion
Read, Int -> SourceFileConversion -> ShowS
[SourceFileConversion] -> ShowS
SourceFileConversion -> String
(Int -> SourceFileConversion -> ShowS)
-> (SourceFileConversion -> String)
-> ([SourceFileConversion] -> ShowS)
-> Show SourceFileConversion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceFileConversion] -> ShowS
$cshowList :: [SourceFileConversion] -> ShowS
show :: SourceFileConversion -> String
$cshow :: SourceFileConversion -> String
showsPrec :: Int -> SourceFileConversion -> ShowS
$cshowsPrec :: Int -> SourceFileConversion -> ShowS
Show, Typeable, Typeable SourceFileConversion
DataType
Constr
Typeable SourceFileConversion
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> SourceFileConversion
    -> c SourceFileConversion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SourceFileConversion)
-> (SourceFileConversion -> Constr)
-> (SourceFileConversion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SourceFileConversion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SourceFileConversion))
-> ((forall b. Data b => b -> b)
    -> SourceFileConversion -> SourceFileConversion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SourceFileConversion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SourceFileConversion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SourceFileConversion -> m SourceFileConversion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SourceFileConversion -> m SourceFileConversion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SourceFileConversion -> m SourceFileConversion)
-> Data SourceFileConversion
SourceFileConversion -> DataType
SourceFileConversion -> Constr
(forall b. Data b => b -> b)
-> SourceFileConversion -> SourceFileConversion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceFileConversion
-> c SourceFileConversion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFileConversion
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SourceFileConversion -> u
forall u.
(forall d. Data d => d -> u) -> SourceFileConversion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFileConversion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceFileConversion
-> c SourceFileConversion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFileConversion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFileConversion)
$cExpandVariables :: Constr
$cNoConversion :: Constr
$tSourceFileConversion :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
gmapMp :: (forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
gmapM :: (forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SourceFileConversion -> m SourceFileConversion
gmapQi :: Int -> (forall d. Data d => d -> u) -> SourceFileConversion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SourceFileConversion -> u
gmapQ :: (forall d. Data d => d -> u) -> SourceFileConversion -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> SourceFileConversion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SourceFileConversion -> r
gmapT :: (forall b. Data b => b -> b)
-> SourceFileConversion -> SourceFileConversion
$cgmapT :: (forall b. Data b => b -> b)
-> SourceFileConversion -> SourceFileConversion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFileConversion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SourceFileConversion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SourceFileConversion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SourceFileConversion)
dataTypeOf :: SourceFileConversion -> DataType
$cdataTypeOf :: SourceFileConversion -> DataType
toConstr :: SourceFileConversion -> Constr
$ctoConstr :: SourceFileConversion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFileConversion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SourceFileConversion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceFileConversion
-> c SourceFileConversion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> SourceFileConversion
-> c SourceFileConversion
$cp1Data :: Typeable SourceFileConversion
Data, SourceFileConversion -> SourceFileConversion -> Bool
(SourceFileConversion -> SourceFileConversion -> Bool)
-> (SourceFileConversion -> SourceFileConversion -> Bool)
-> Eq SourceFileConversion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceFileConversion -> SourceFileConversion -> Bool
$c/= :: SourceFileConversion -> SourceFileConversion -> Bool
== :: SourceFileConversion -> SourceFileConversion -> Bool
$c== :: SourceFileConversion -> SourceFileConversion -> Bool
Eq, (forall x. SourceFileConversion -> Rep SourceFileConversion x)
-> (forall x. Rep SourceFileConversion x -> SourceFileConversion)
-> Generic SourceFileConversion
forall x. Rep SourceFileConversion x -> SourceFileConversion
forall x. SourceFileConversion -> Rep SourceFileConversion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourceFileConversion x -> SourceFileConversion
$cfrom :: forall x. SourceFileConversion -> Rep SourceFileConversion x
Generic)

instance Hashable SourceFileConversion

instance Binary SourceFileConversion

instance NFData SourceFileConversion

readTemplateFile ::
  (MonadIO (Eff e), '[ExcB9, EnvironmentReader] <:: e) =>
  SourceFile ->
  Eff e Text
readTemplateFile :: SourceFile -> Eff e Text
readTemplateFile (Source SourceFileConversion
conv String
f') = do
  let onErrorFileName :: SomeException -> Eff e Text
onErrorFileName SomeException
e =
        String -> Eff e Text
forall a. HasCallStack => String -> a
error
          ( String -> String -> ShowS
forall r. PrintfType r => String -> r
printf
              "Failed to substitute templates in source \
              \file name '%s'/\nError: %s\n"
              String
f'
              (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e)
          )
  Text
f <- Text -> Eff e Text
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
Text -> Eff e Text
subst (String -> Text
Text.pack String
f') Eff e Text -> (SomeException -> Eff e Text) -> Eff e Text
forall (e :: [* -> *]) a.
Member ExcB9 e =>
Eff e a -> (SomeException -> Eff e a) -> Eff e a
`catchB9Error` SomeException -> Eff e Text
onErrorFileName
  Text
c <- IO Text -> Eff e Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
Text.readFile (Text -> String
Text.unpack Text
f))
  case SourceFileConversion
conv of
    SourceFileConversion
NoConversion -> Text -> Eff e Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
c
    SourceFileConversion
ExpandVariables ->
      let onErrorFile :: SomeException -> Eff e Text
onErrorFile SomeException
e =
            String -> Eff e Text
forall a. HasCallStack => String -> a
error
              ( String -> Text -> ShowS
forall r. PrintfType r => String -> r
printf
                  String
"readTemplateFile '%s' failed: \n%s\n"
                  Text
f
                  (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
e)
              )
       in Text -> Eff e Text
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
Text -> Eff e Text
subst Text
c Eff e Text -> (SomeException -> Eff e Text) -> Eff e Text
forall (e :: [* -> *]) a.
Member ExcB9 e =>
Eff e a -> (SomeException -> Eff e a) -> Eff e a
`catchB9Error` SomeException -> Eff e Text
onErrorFile

-- | 'Text' template substitution.
subst :: (Member ExcB9 e, Member EnvironmentReader e) => Text -> Eff e Text
subst :: Text -> Eff e Text
subst Text
templateStr = do
  Template
t <- Text -> Eff e Template
forall (e :: [* -> *]). Member ExcB9 e => Text -> Eff e Template
templateSafeExcB9 Text
templateStr
  Text -> Text
LazyText.toStrict (Text -> Text) -> Eff e Text -> Eff e Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template -> (Text -> Eff e Text) -> Eff e Text
forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA Template
t Text -> Eff e Text
forall (e :: [* -> *]).
('[ExcB9, EnvironmentReader] <:: e) =>
Text -> Eff e Text
lookupOrThrow

-- | 'String' template substitution
substStr ::
  (Member ExcB9 e, Member EnvironmentReader e) => String -> Eff e String
substStr :: String -> Eff e String
substStr String
templateStr = do
  Template
t <- Text -> Eff e Template
forall (e :: [* -> *]). Member ExcB9 e => Text -> Eff e Template
templateSafeExcB9 (String -> Text
Text.pack String
templateStr)
  Text -> String
Text.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LazyText.toStrict (Text -> String) -> Eff e Text -> Eff e String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Template -> ContextA (Eff e) -> Eff e Text
forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA Template
t ContextA (Eff e)
forall (e :: [* -> *]).
('[ExcB9, EnvironmentReader] <:: e) =>
Text -> Eff e Text
lookupOrThrow

templateSafeExcB9 :: Member ExcB9 e => Text -> Eff e Template
templateSafeExcB9 :: Text -> Eff e Template
templateSafeExcB9 Text
templateStr = case Text -> Either (Int, Int) Template
templateSafe Text
templateStr of
  Left (Int
row, Int
col) ->
    String -> Eff e Template
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
      ( String
"Invalid template, error at row: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
row
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", col: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" in: \""
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
templateStr
      )
  Right Template
t -> Template -> Eff e Template
forall (m :: * -> *) a. Monad m => a -> m a
return Template
t

substFile ::
  (Member EnvironmentReader e, Member ExcB9 e, MonadIO (Eff e)) =>
  FilePath ->
  FilePath ->
  Eff e ()
substFile :: String -> String -> Eff e ()
substFile String
src String
dest = do
  Text
templatedText <- IO Text -> Eff e Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Text
Text.readFile String
src)
  let t :: Either (Int, Int) Template
t = Text -> Either (Int, Int) Template
templateSafe Text
templatedText
  case Either (Int, Int) Template
t of
    Left (Int
r, Int
c) ->
      let badLine :: Text
badLine = [Text] -> Text
Text.unlines (Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
r (Text -> [Text]
Text.lines Text
templatedText))
          colMarker :: Text
colMarker = Int -> Text -> Text
Text.replicate (Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"^"
       in String -> Eff e ()
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error
            ( String -> String -> Int -> Text -> Text -> String
forall r. PrintfType r => String -> r
printf
                String
"Template error in file '%s' line %i:\n\n%s\n%s\n"
                String
src
                Int
r
                Text
badLine
                Text
colMarker
            )
    Right Template
template' -> do
      Text
out <- Template -> ContextA (Eff e) -> Eff e Text
forall (f :: * -> *).
Applicative f =>
Template -> ContextA f -> f Text
renderA Template
template' (String -> ContextA (Eff e)
forall (e :: [* -> *]).
(Member EnvironmentReader e, Member ExcB9 e, MonadIO (Eff e)) =>
String -> Text -> Eff e Text
templateEnvLookupSrcFile String
src)
      IO () -> Eff e ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> Text -> IO ()
Text.writeFile String
dest (Text -> Text
LazyText.toStrict Text
out))

templateEnvLookupSrcFile ::
  (Member EnvironmentReader e, Member ExcB9 e, MonadIO (Eff e)) =>
  FilePath ->
  Text ->
  Eff e Text
templateEnvLookupSrcFile :: String -> Text -> Eff e Text
templateEnvLookupSrcFile String
src Text
x = do
  Either SomeException Text
r <- Eff e Text -> Eff e (Either SomeException Text)
forall (e :: [* -> *]) a.
Member ExcB9 e =>
Eff e a -> Eff e (Either SomeException a)
catchB9ErrorAsEither (Text -> Eff e Text
forall (e :: [* -> *]).
('[ExcB9, EnvironmentReader] <:: e) =>
Text -> Eff e Text
lookupOrThrow Text
x)
  (SomeException -> Eff e Text)
-> (Text -> Eff e Text) -> Either SomeException Text -> Eff e Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> Eff e Text
err Text -> Eff e Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException Text
r
  where
    err :: SomeException -> Eff e Text
err SomeException
e = String -> Eff e Text
forall (e :: [* -> *]) a. Member ExcB9 e => String -> Eff e a
throwB9Error (SomeException -> String
forall a. Show a => a -> String
show SomeException
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\nIn file: \'" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
src String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\'\n")

substPath ::
  (Member EnvironmentReader e, Member ExcB9 e) =>
  SystemPath ->
  Eff e SystemPath
substPath :: SystemPath -> Eff e SystemPath
substPath SystemPath
src = case SystemPath
src of
  Path String
p -> String -> SystemPath
Path (String -> SystemPath) -> Eff e String -> Eff e SystemPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
p
  InHomeDir String
p -> String -> SystemPath
InHomeDir (String -> SystemPath) -> Eff e String -> Eff e SystemPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
p
  InB9UserDir String
p -> String -> SystemPath
InB9UserDir (String -> SystemPath) -> Eff e String -> Eff e SystemPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
p
  InTempDir String
p -> String -> SystemPath
InTempDir (String -> SystemPath) -> Eff e String -> Eff e SystemPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Eff e String
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
String -> Eff e String
substStr String
p

instance Arbitrary SourceFile where
  arbitrary :: Gen SourceFile
arbitrary =
    SourceFileConversion -> String -> SourceFile
Source
      (SourceFileConversion -> String -> SourceFile)
-> Gen SourceFileConversion -> Gen (String -> SourceFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SourceFileConversion] -> Gen SourceFileConversion
forall a. [a] -> Gen a
elements [SourceFileConversion
NoConversion, SourceFileConversion
ExpandVariables]
      Gen (String -> SourceFile) -> Gen String -> Gen SourceFile
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen String -> Gen String
forall a. Gen a -> Gen a
smaller Gen String
arbitraryFilePath

-- | Extend an 'Environment' with new bindings, where each value may contain
-- string templates with like @"Hello $name, how is life on $planet these days?"@.
--
-- @since 0.5.64
withSubstitutedStringBindings ::
  (Member EnvironmentReader e, Member ExcB9 e) =>
  [(String, String)] ->
  Eff e s ->
  Eff e s
withSubstitutedStringBindings :: [(String, String)] -> Eff e s -> Eff e s
withSubstitutedStringBindings [(String, String)]
bs Eff e s
nested = do
  let extend :: Environment -> (String, String) -> Eff e Environment
extend Environment
env (String
k, String
v) = (Environment -> Environment)
-> Eff e Environment -> Eff e Environment
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
(Environment -> Environment) -> Eff e a -> Eff e a
localEnvironment (Environment -> Environment -> Environment
forall a b. a -> b -> a
const Environment
env) (Eff e Environment -> Eff e Environment)
-> Eff e Environment -> Eff e Environment
forall a b. (a -> b) -> a -> b
$ do
        (Text, Text)
kv <- (String -> Text
Text.pack String
k,) (Text -> (Text, Text)) -> Eff e Text -> Eff e (Text, Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Eff e Text
forall (e :: [* -> *]).
(Member ExcB9 e, Member EnvironmentReader e) =>
Text -> Eff e Text
subst (String -> Text
Text.pack String
v)
        (Text, Text) -> Environment -> Eff e Environment
forall (e :: [* -> *]).
Member ExcB9 e =>
(Text, Text) -> Environment -> Eff e Environment
addBinding (Text, Text)
kv Environment
env
  Environment
env <- Eff e Environment
forall (e :: [* -> *]).
Member EnvironmentReader e =>
Eff e Environment
askEnvironment
  Environment
envExt <- (Environment -> (String, String) -> Eff e Environment)
-> Environment -> [(String, String)] -> Eff e Environment
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Environment -> (String, String) -> Eff e Environment
forall (e :: [* -> *]).
(FindElem EnvironmentReader e, FindElem ExcB9 e) =>
Environment -> (String, String) -> Eff e Environment
extend Environment
env [(String, String)]
bs
  (Environment -> Environment) -> Eff e s -> Eff e s
forall (e :: [* -> *]) a.
Member EnvironmentReader e =>
(Environment -> Environment) -> Eff e a -> Eff e a
localEnvironment (Environment -> Environment -> Environment
forall a b. a -> b -> a
const Environment
envExt) Eff e s
nested