{-# LANGUAGE CPP, TemplateHaskell, OverloadedStrings #-}
module NgxExport.Tools.EDE (
renderEDETemplate
,renderEDETemplateWith
,renderEDETemplateFromFreeValue
) where
import NgxExport
import NgxExport.Tools.SimpleService
import NgxExport.Tools.SplitService
import Text.EDE
import Text.EDE.Filters
#ifdef EDE_USE_PRETTYPRINTER
#if MIN_VERSION_prettyprinter(1,7,0)
import Prettyprinter (unAnnotate)
#else
import Data.Text.Prettyprint.Doc (unAnnotate)
#endif
#else
import Text.PrettyPrint.ANSI.Leijen (plain)
#endif
import qualified Data.HashMap.Strict as HM
import Data.HashMap.Strict (HashMap)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C8L
import Data.ByteString.Base64.URL
import Data.IORef
import Data.Text (Text)
import qualified Data.Text.Encoding as T
import qualified Data.Text.Lazy.Encoding as LT
import Data.Aeson (encode, decode, Value (String))
import Network.HTTP.Types.URI (urlEncode)
import Control.Exception (Exception, throwIO)
import Control.Arrow
import System.IO.Unsafe
type InputTemplates = (FilePath, [(ByteString, ByteString)])
type Templates = HashMap ByteString (Result Template)
newtype EDERenderError = EDERenderError String
instance Exception EDERenderError
instance Show EDERenderError where
show :: EDERenderError -> [Char]
show (EDERenderError [Char]
s) = [Char]
"EDE ERROR: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
s
templates :: IORef Templates
templates :: IORef Templates
templates = IO (IORef Templates) -> IORef Templates
forall a. IO a -> a
unsafePerformIO (IO (IORef Templates) -> IORef Templates)
-> IO (IORef Templates) -> IORef Templates
forall a b. (a -> b) -> a -> b
$ Templates -> IO (IORef Templates)
forall a. a -> IO (IORef a)
newIORef Templates
forall k v. HashMap k v
HM.empty
{-# NOINLINE templates #-}
compileEDETemplates :: InputTemplates -> Bool -> IO L.ByteString
compileEDETemplates :: InputTemplates -> Bool -> IO ByteString
compileEDETemplates = (InputTemplates -> IO ByteString)
-> InputTemplates -> Bool -> IO ByteString
forall a. (a -> IO ByteString) -> a -> Bool -> IO ByteString
ignitionService ((InputTemplates -> IO ByteString)
-> InputTemplates -> Bool -> IO ByteString)
-> (InputTemplates -> IO ByteString)
-> InputTemplates
-> Bool
-> IO ByteString
forall a b. (a -> b) -> a -> b
$ \([Char]
path, [(ByteString, ByteString)]
itpls) -> do
IORef Templates -> Templates -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Templates
templates (Templates -> IO ()) -> Templates -> IO ()
forall a b. (a -> b) -> a -> b
$
(Templates -> (ByteString, ByteString) -> Templates)
-> Templates -> [(ByteString, ByteString)] -> Templates
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Templates
a (ByteString
k, ByteString
v) -> ByteString -> Result Template -> Templates -> Templates
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ByteString
k (IO (Result Template) -> Result Template
forall a. IO a -> a
unsafePerformIO (IO (Result Template) -> Result Template)
-> IO (Result Template) -> Result Template
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString -> IO (Result Template)
parseIO [Char]
path ByteString
v) Templates
a)
Templates
forall k v. HashMap k v
HM.empty [(ByteString, ByteString)]
itpls
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
ngxExportSimpleServiceTyped 'compileEDETemplates ''InputTemplates
SingleShotService
filters :: HashMap Id Term
filters :: HashMap Id Term
filters = [(Id, Term)] -> HashMap Id Term
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
[Id
"b64" Id -> (Value -> Id) -> (Id, Term)
forall a. Quote a => Id -> a -> (Id, Term)
@: (ByteString -> Id) -> Value -> Id
applyToValue ByteString -> Id
encodeBase64
,Id
"uenc" Id -> (Value -> Id) -> (Id, Term)
forall a. Quote a => Id -> a -> (Id, Term)
@: (ByteString -> Id) -> Value -> Id
applyToValue (ByteString -> Id
T.decodeUtf8 (ByteString -> Id)
-> (ByteString -> ByteString) -> ByteString -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlEncode Bool
False)
]
where applyToValue :: (ByteString -> Text) -> Value -> Text
applyToValue :: (ByteString -> Id) -> Value -> Id
applyToValue ByteString -> Id
f (String Id
t) = ByteString -> Id
f (ByteString -> Id) -> ByteString -> Id
forall a b. (a -> b) -> a -> b
$ Id -> ByteString
T.encodeUtf8 Id
t
applyToValue ByteString -> Id
f Value
v = ByteString -> Id
f (ByteString -> Id) -> ByteString -> Id
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
L.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
v
renderEDETemplate :: L.ByteString
-> ByteString
-> IO L.ByteString
renderEDETemplate :: ByteString -> ByteString -> IO ByteString
renderEDETemplate = (ByteString -> Maybe Value)
-> ByteString -> ByteString -> IO ByteString
renderEDETemplateWith ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
decode
renderEDETemplateWith
:: (L.ByteString -> Maybe Value)
-> L.ByteString
-> ByteString
-> IO L.ByteString
renderEDETemplateWith :: (ByteString -> Maybe Value)
-> ByteString -> ByteString -> IO ByteString
renderEDETemplateWith ByteString -> Maybe Value
fdec ByteString
v ByteString
k = do
Templates
tpls <- IORef Templates -> IO Templates
forall a. IORef a -> IO a
readIORef IORef Templates
templates
case ByteString -> Templates -> Maybe (Result Template)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ByteString
k Templates
tpls of
Maybe (Result Template)
Nothing -> EDERenderError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (EDERenderError -> IO ByteString)
-> EDERenderError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> EDERenderError
EDERenderError ([Char] -> EDERenderError) -> [Char] -> EDERenderError
forall a b. (a -> b) -> a -> b
$
[Char]
"EDE template " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
C8.unpack ByteString
k [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" was not found"
Just (Failure AnsiDoc
msg) -> EDERenderError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (EDERenderError -> IO ByteString)
-> EDERenderError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> EDERenderError
EDERenderError ([Char] -> EDERenderError) -> [Char] -> EDERenderError
forall a b. (a -> b) -> a -> b
$ AnsiDoc -> [Char]
forall {ann}. Doc ann -> [Char]
showPlain AnsiDoc
msg
Just (Success Template
tpl) ->
case ByteString -> Maybe Value
fdec ByteString
v Maybe Value
-> (Value -> Maybe (HashMap Id Value)) -> Maybe (HashMap Id Value)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Maybe (HashMap Id Value)
fromValue of
Maybe (HashMap Id Value)
Nothing -> EDERenderError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (EDERenderError -> IO ByteString)
-> EDERenderError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> EDERenderError
EDERenderError ([Char] -> EDERenderError) -> [Char] -> EDERenderError
forall a b. (a -> b) -> a -> b
$
[Char]
"Failed to decode value '" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
C8L.unpack ByteString
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"'"
Just HashMap Id Value
obj ->
case HashMap Id Term -> Template -> HashMap Id Value -> Result Text
renderWith HashMap Id Term
filters Template
tpl HashMap Id Value
obj of
Failure AnsiDoc
msg -> EDERenderError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO (EDERenderError -> IO ByteString)
-> EDERenderError -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [Char] -> EDERenderError
EDERenderError ([Char] -> EDERenderError) -> [Char] -> EDERenderError
forall a b. (a -> b) -> a -> b
$ AnsiDoc -> [Char]
forall {ann}. Doc ann -> [Char]
showPlain AnsiDoc
msg
Success Text
r -> ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
LT.encodeUtf8 Text
r
where showPlain :: Doc ann -> [Char]
showPlain = Doc Any -> [Char]
forall a. Show a => a -> [Char]
show (Doc Any -> [Char]) -> (Doc ann -> Doc Any) -> Doc ann -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#ifdef EDE_USE_PRETTYPRINTER
Doc ann -> Doc Any
forall ann xxx. Doc ann -> Doc xxx
unAnnotate
#else
plain
#endif
ngxExportAsyncOnReqBody 'renderEDETemplate
renderEDETemplateFromFreeValue
:: ByteString
-> IO L.ByteString
renderEDETemplateFromFreeValue :: ByteString -> IO ByteString
renderEDETemplateFromFreeValue = (ByteString -> ByteString -> IO ByteString)
-> (ByteString, ByteString) -> IO ByteString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((ByteString -> ByteString -> IO ByteString)
-> ByteString -> ByteString -> IO ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> IO ByteString
renderEDETemplate) ((ByteString, ByteString) -> IO ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(ByteString -> ByteString)
-> (ByteString, ByteString) -> (ByteString, ByteString)
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (ByteString -> ByteString
L.fromStrict (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> ByteString
ByteString -> ByteString
C8.tail) ((ByteString, ByteString) -> (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
C8.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'|')
ngxExportIOYY 'renderEDETemplateFromFreeValue