{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
-- | A Shakespearean module for general text processing, introducing type-safe,
-- compile-time variable interpolation.
--
-- Text templates use the same parser as for other shakespearean templates
-- which enables variable interpolation using @#{..}@.  The parser also
-- recognize the @@{..}@ and @^{..}@ syntax.
--
-- If it is necessary that your template produces the output containing one of
-- the interpolation syntax you can escape the sequence using a backslash:
--
-- > λ> :set -XQuasiQuotes
-- > λ> let bar = 23 :: Int in [st|#{bar}|] :: Text
--
-- produces "23", but
--
-- > λ> let bar = 23 :: Int in [st|#\{bar}|] :: Text
--
-- returns "#{bar}".  The escaping backslash is removed from the output.
--
-- Further reading:
-- Shakespearean templates: <https://www.yesodweb.com/book/shakespearean-templates>
module Text.Shakespeare.Text
    ( TextUrl
    , ToText (..)
    , renderTextUrl
    , stext
    , stextFile
    , text
    , textFile
    , textFileDebug
    , textFileReload
    , st -- | strict text
    , lt -- | lazy text, same as stext :)
    , sbt -- | strict text whose left edge is aligned with bar ('|')
    , lbt -- | lazy text, whose left edge is aligned with bar ('|')
    -- * Yesod code generation
    , codegen
    , codegenSt
    , codegenFile
    , codegenFileReload
    ) where

import Language.Haskell.TH.Quote (QuasiQuoter (..))
import Language.Haskell.TH.Syntax
import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)
import Data.Text.Lazy.Builder.Int (decimal)
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import Text.Shakespeare
import Data.Int (Int32, Int64)

renderTextUrl :: RenderUrl url -> TextUrl url -> TL.Text
renderTextUrl :: RenderUrl url -> TextUrl url -> Text
renderTextUrl RenderUrl url
r TextUrl url
s = Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ TextUrl url
s RenderUrl url
r

type TextUrl url = RenderUrl url -> Builder

class ToText a where
    toText :: a -> Builder
instance ToText Builder where toText :: Builder -> Builder
toText = Builder -> Builder
forall a. a -> a
id
instance ToText [Char ] where toText :: [Char] -> Builder
toText = Text -> Builder
fromLazyText (Text -> Builder) -> ([Char] -> Text) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
TL.pack
instance ToText TS.Text where toText :: Text -> Builder
toText = Text -> Builder
fromText
instance ToText TL.Text where toText :: Text -> Builder
toText = Text -> Builder
fromLazyText

instance ToText Int32 where toText :: Int32 -> Builder
toText = Int32 -> Builder
forall a. Integral a => a -> Builder
decimal
instance ToText Int64 where toText :: Int64 -> Builder
toText = Int64 -> Builder
forall a. Integral a => a -> Builder
decimal
instance ToText Int   where toText :: Int -> Builder
toText = Int -> Builder
forall a. Integral a => a -> Builder
decimal

settings :: Q ShakespeareSettings
settings :: Q ShakespeareSettings
settings = do
  Exp
toTExp <- [|toText|]
  Exp
wrapExp <- [|id|]
  Exp
unWrapExp <- [|id|]
  ShakespeareSettings -> Q ShakespeareSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ShakespeareSettings -> Q ShakespeareSettings)
-> ShakespeareSettings -> Q ShakespeareSettings
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings
defaultShakespeareSettings { toBuilder :: Exp
toBuilder = Exp
toTExp
  , wrap :: Exp
wrap = Exp
wrapExp
  , unwrap :: Exp
unwrap = Exp
unWrapExp
  }

-- | "Simple text" quasi-quoter. May only be used to generate expressions.
--
-- Generated expressions have type 'TL.Text'.
--
-- @
-- >>> do let x = "world"
--        'Data.Text.Lazy.IO.putStrLn' ['stext'|Hello, #{x}!|]
-- Hello, world!
-- @
stext :: QuasiQuoter
stext :: QuasiQuoter
stext =
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    Exp
render <- [|toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

lt, st, text, lbt, sbt :: QuasiQuoter
lt :: QuasiQuoter
lt = QuasiQuoter
stext

st :: QuasiQuoter
st = 
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    Exp
render <- [|TL.toStrict . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

text :: QuasiQuoter
text = QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    QuasiQuoter -> [Char] -> Q Exp
quoteExp (ShakespeareSettings -> QuasiQuoter
shakespeare ShakespeareSettings
rs) ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'\r') [Char]
s
    }

dropBar :: [TL.Text] -> [TL.Text]
dropBar :: [Text] -> [Text]
dropBar [] = []
dropBar (Text
c:[Text]
cx) = Text
cText -> [Text] -> [Text]
forall a. a -> [a] -> [a]
:[Text] -> [Text]
dropBar' [Text]
cx
  where
    dropBar' :: [Text] -> [Text]
dropBar' [Text]
txt = [Text] -> [Text]
forall a. [a] -> [a]
reverse ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
drop Int
1 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> Text -> Text
TL.drop Int64
1 (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
TL.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'|')) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
txt

lbt :: QuasiQuoter
lbt = 
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    Exp
render <- [|TL.unlines . dropBar . TL.lines . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

sbt :: QuasiQuoter
sbt = 
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    Exp
render <- [|TL.toStrict . TL.unlines . dropBar . TL.lines . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

textFile :: FilePath -> Q Exp
textFile :: [Char] -> Q Exp
textFile [Char]
fp = do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    ShakespeareSettings -> [Char] -> Q Exp
shakespeareFile ShakespeareSettings
rs [Char]
fp


textFileDebug :: FilePath -> Q Exp
textFileDebug :: [Char] -> Q Exp
textFileDebug = [Char] -> Q Exp
textFileReload
{-# DEPRECATED textFileDebug "Please use textFileReload instead" #-}

textFileReload :: FilePath -> Q Exp
textFileReload :: [Char] -> Q Exp
textFileReload [Char]
fp = do
    ShakespeareSettings
rs <- Q ShakespeareSettings
settings
    ShakespeareSettings -> [Char] -> Q Exp
shakespeareFileReload ShakespeareSettings
rs [Char]
fp

-- | Like 'stext', but reads an external file at compile-time.
--
-- @since 2.0.22
stextFile :: FilePath -> Q Exp
stextFile :: [Char] -> Q Exp
stextFile [Char]
fp = do
  ShakespeareSettings
rs <- Q ShakespeareSettings
settings
  [|toLazyText $(shakespeareFile rs { justVarInterpolation = True } fp)|]

-- | codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
codegenSettings :: Q ShakespeareSettings
codegenSettings :: Q ShakespeareSettings
codegenSettings = do
  Exp
toTExp <- [|toText|]
  Exp
wrapExp <- [|id|]
  Exp
unWrapExp <- [|id|]
  ShakespeareSettings -> Q ShakespeareSettings
forall (m :: * -> *) a. Monad m => a -> m a
return (ShakespeareSettings -> Q ShakespeareSettings)
-> ShakespeareSettings -> Q ShakespeareSettings
forall a b. (a -> b) -> a -> b
$ ShakespeareSettings
defaultShakespeareSettings { toBuilder :: Exp
toBuilder = Exp
toTExp
  , wrap :: Exp
wrap = Exp
wrapExp
  , unwrap :: Exp
unwrap = Exp
unWrapExp
  , varChar :: Char
varChar = Char
'~'
  , urlChar :: Char
urlChar = Char
'*'
  , intChar :: Char
intChar = Char
'&'
  , justVarInterpolation :: Bool
justVarInterpolation = Bool
True -- always!
  }

-- | codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
-- You can use the normal text quasiquoters to generate code
codegen :: QuasiQuoter
codegen :: QuasiQuoter
codegen =
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
codegenSettings
    Exp
render <- [|toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

-- | Generates strict Text
-- codegen is designed for generating Yesod code, including templates
-- So it uses different interpolation characters that won't clash with templates.
codegenSt :: QuasiQuoter
codegenSt :: QuasiQuoter
codegenSt =
  QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
    ShakespeareSettings
rs <- Q ShakespeareSettings
codegenSettings
    Exp
render <- [|TL.toStrict . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFromString ShakespeareSettings
rs { justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
s
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)
    }

codegenFileReload :: FilePath -> Q Exp
codegenFileReload :: [Char] -> Q Exp
codegenFileReload [Char]
fp = do
    ShakespeareSettings
rs <- Q ShakespeareSettings
codegenSettings
    Exp
render <- [|TL.toStrict . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFileReload ShakespeareSettings
rs{ justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
fp
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)

codegenFile :: FilePath -> Q Exp
codegenFile :: [Char] -> Q Exp
codegenFile [Char]
fp = do
    ShakespeareSettings
rs <- Q ShakespeareSettings
codegenSettings
    Exp
render <- [|TL.toStrict . toLazyText|]
    Exp
rendered <- ShakespeareSettings -> [Char] -> Q Exp
shakespeareFile ShakespeareSettings
rs{ justVarInterpolation :: Bool
justVarInterpolation = Bool
True } [Char]
fp
    Exp -> Q Exp
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp
render Exp -> Exp -> Exp
`AppE` Exp
rendered)