{-# LANGUAGE FlexibleContexts #-}
module B9.Artifact.Content.StringTemplate
( subst
, substFile
, substPath
, readTemplateFile
, withSubstitutedStringBindings
, SourceFile(..)
, SourceFileConversion(..)
)
where
import B9.B9Error
import B9.Environment
import B9.QCUtil
import Control.Exception ( displayException )
import Control.Monad ( foldM )
import Control.Monad.IO.Class ( MonadIO(liftIO) )
import Control.Eff as Eff
import Control.Monad.Trans.Identity ( )
import Control.Parallel.Strategies
import Data.Binary
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.Data
import Data.Hashable
import qualified Data.Text.Lazy as LazyT
import qualified Data.Text as StrictT
import qualified Data.Text.Encoding as StrictE
import qualified Data.Text.Lazy.Encoding as LazyE
import Data.Text.Template ( renderA
, templateSafe
)
import GHC.Generics ( Generic )
import System.IO.B9Extras
import Test.QuickCheck
import Text.Printf
data SourceFile =
Source SourceFileConversion
FilePath
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable SourceFile
instance Binary SourceFile
instance NFData SourceFile
data SourceFileConversion
= NoConversion
| ExpandVariables
deriving (Read, Show, Typeable, Data, Eq, Generic)
instance Hashable SourceFileConversion
instance Binary SourceFileConversion
instance NFData SourceFileConversion
readTemplateFile
:: (MonadIO (Eff e), '[ExcB9, EnvironmentReader] <:: e)
=> SourceFile
-> Eff e Lazy.ByteString
readTemplateFile (Source conv f') = do
let
onErrorFileName e = error
(printf
"Failed to substitute templates in source \
\file name '%s'/\nError: %s\n"
f'
(displayException e)
)
f <- subst f' `catchB9Error` onErrorFileName
c <- liftIO (Lazy.readFile f)
case conv of
NoConversion -> return c
ExpandVariables ->
let onErrorFile e =
error
(printf "readTemplateFile '%s' failed: \n%s\n"
f
(displayException e)
)
in substEB c `catchB9Error` onErrorFile
subst :: (Member ExcB9 e, Member EnvironmentReader e) => String -> Eff e String
subst templateStr = LazyT.unpack . LazyE.decodeUtf8 <$> substEB
(LazyE.encodeUtf8 (LazyT.pack templateStr))
substEB
:: (Member ExcB9 e, Member EnvironmentReader e)
=> Lazy.ByteString
-> Eff e Lazy.ByteString
substEB templateStr = do
t <- template'
LazyE.encodeUtf8 <$> renderA t templateEnvLookup
where
templateEnvLookup
:: (Member EnvironmentReader e, Member ExcB9 e)
=> StrictT.Text
-> Eff e StrictT.Text
templateEnvLookup x = LazyT.toStrict <$> lookupOrThrow (LazyT.fromStrict x)
template' =
case templateSafe (LazyT.toStrict (LazyE.decodeUtf8 templateStr)) of
Left (row, col) -> throwB9Error
( "Invalid template, error at row: "
++ show row
++ ", col: "
++ show col
++ " in: \""
++ show templateStr
)
Right t -> return t
substFile
:: (Member EnvironmentReader e, Member ExcB9 e, MonadIO (Eff e))
=> FilePath
-> FilePath
-> Eff e ()
substFile src dest = do
templateBs <- liftIO (Strict.readFile src)
let t = templateSafe (StrictE.decodeUtf8 templateBs)
case t of
Left (r, c) ->
let badLine =
unlines
(take r (lines (StrictT.unpack (StrictE.decodeUtf8 templateBs))))
colMarker = replicate (c - 1) '-' ++ "^"
in throwB9Error
(printf "Template error in file '%s' line %i:\n\n%s\n%s\n"
src
r
badLine
colMarker
)
Right template' -> do
out <- LazyE.encodeUtf8
<$> renderA template' (templateEnvLookupSrcFile src)
liftIO (Lazy.writeFile dest out)
templateEnvLookupSrcFile
:: (Member EnvironmentReader e, Member ExcB9 e, MonadIO (Eff e))
=> FilePath
-> StrictT.Text
-> Eff e StrictT.Text
templateEnvLookupSrcFile src x = do
r <- catchB9ErrorAsEither (lookupOrThrow (LazyT.fromStrict x))
either err (pure . LazyT.toStrict) r
where err e = throwB9Error (show e ++ "\nIn file: \'" ++ src ++ "\'\n")
substPath
:: (Member EnvironmentReader e, Member ExcB9 e)
=> SystemPath
-> Eff e SystemPath
substPath src = case src of
Path p -> Path <$> subst p
InHomeDir p -> InHomeDir <$> subst p
InB9UserDir p -> InB9UserDir <$> subst p
InTempDir p -> InTempDir <$> subst p
instance Arbitrary SourceFile where
arbitrary =
Source
<$> elements [NoConversion, ExpandVariables]
<*> smaller arbitraryFilePath
withSubstitutedStringBindings
:: (Member EnvironmentReader e, Member ExcB9 e)
=> [(String, String)]
-> Eff e s
-> Eff e s
withSubstitutedStringBindings bs nested = do
let extend env (k, v) = localEnvironment (const env) $ do
kv <- (k, ) <$> subst v
addStringBinding kv env
env <- askEnvironment
envExt <- foldM extend env bs
localEnvironment (const envExt) nested