{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Shakespeare.Text
( TextUrl
, ToText (..)
, renderTextUrl
, stext
, stextFile
, text
, textFile
, textFileDebug
, textFileReload
, st
, lt
, sbt
, lbt
, 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 :: forall url. 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
toTExp <- [|toText|]
wrapExp <- [|id|]
unWrapExp <- [|id|]
return $ defaultShakespeareSettings { toBuilder = toTExp
, wrap = wrapExp
, unwrap = unWrapExp
}
stext :: QuasiQuoter
stext :: QuasiQuoter
stext =
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
settings
render <- [|toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
lt, st, text, lbt, sbt :: QuasiQuoter
lt :: QuasiQuoter
lt = QuasiQuoter
stext
st :: QuasiQuoter
st =
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
settings
render <- [|TL.toStrict . toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
text :: QuasiQuoter
text = QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
settings
quoteExp (shakespeare rs) $ filter (/='\r') 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 { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
settings
render <- [|TL.unlines . dropBar . TL.lines . toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
sbt :: QuasiQuoter
sbt =
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
settings
render <- [|TL.toStrict . TL.unlines . dropBar . TL.lines . toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
textFile :: FilePath -> Q Exp
textFile :: [Char] -> Q Exp
textFile [Char]
fp = do
rs <- Q ShakespeareSettings
settings
shakespeareFile rs 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
rs <- Q ShakespeareSettings
settings
shakespeareFileReload rs fp
stextFile :: FilePath -> Q Exp
stextFile :: [Char] -> Q Exp
stextFile [Char]
fp = do
rs <- Q ShakespeareSettings
settings
[|toLazyText $(shakespeareFile rs { justVarInterpolation = True } fp)|]
codegenSettings :: Q ShakespeareSettings
codegenSettings :: Q ShakespeareSettings
codegenSettings = do
toTExp <- [|toText|]
wrapExp <- [|id|]
unWrapExp <- [|id|]
return $ defaultShakespeareSettings { toBuilder = toTExp
, wrap = wrapExp
, unwrap = unWrapExp
, varChar = '~'
, urlChar = '*'
, intChar = '&'
, justVarInterpolation = True
}
codegen :: QuasiQuoter
codegen :: QuasiQuoter
codegen =
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
codegenSettings
render <- [|toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
codegenSt :: QuasiQuoter
codegenSt :: QuasiQuoter
codegenSt =
QuasiQuoter { quoteExp :: [Char] -> Q Exp
quoteExp = \[Char]
s -> do
rs <- Q ShakespeareSettings
codegenSettings
render <- [|TL.toStrict . toLazyText|]
rendered <- shakespeareFromString rs { justVarInterpolation = True } s
return (render `AppE` rendered)
}
codegenFileReload :: FilePath -> Q Exp
codegenFileReload :: [Char] -> Q Exp
codegenFileReload [Char]
fp = do
rs <- Q ShakespeareSettings
codegenSettings
render <- [|TL.toStrict . toLazyText|]
rendered <- shakespeareFileReload rs{ justVarInterpolation = True } fp
return (render `AppE` rendered)
codegenFile :: FilePath -> Q Exp
codegenFile :: [Char] -> Q Exp
codegenFile [Char]
fp = do
rs <- Q ShakespeareSettings
codegenSettings
render <- [|TL.toStrict . toLazyText|]
rendered <- shakespeareFile rs{ justVarInterpolation = True } fp
return (render `AppE` rendered)