Text.hs

{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-missing-fields #-}
module Text.Shakespeare.Text
    ( TextUrl
    , ToText (..)
    , renderTextUrl
    , stext
    , 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 r s = toLazyText $ s r

type TextUrl url = RenderUrl url -> Builder

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

instance ToText Int32 where toText = decimal
instance ToText Int64 where toText = decimal
instance ToText Int   where toText = decimal

settings :: Q ShakespeareSettings
settings = do
  toTExp <- [|toText|]
  wrapExp <- [|id|]
  unWrapExp <- [|id|]
  return $ defaultShakespeareSettings { toBuilder = toTExp
  , wrap = wrapExp
  , unwrap = unWrapExp
  }


stext, lt, st, text, lbt, sbt :: QuasiQuoter
stext = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }
lt = stext

st = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

text = QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    quoteExp (shakespeare rs) $ filter (/='\r') s
    }

dropBar :: [TL.Text] -> [TL.Text]
dropBar [] = []
dropBar (c:cx) = c:dropBar' cx
  where
    dropBar' txt = reverse $ drop 1 $ map (TL.drop 1 . TL.dropWhile (/= '|')) $ reverse txt

lbt = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- settings
    render <- [|TL.unlines . dropBar . TL.lines . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

sbt = 
  QuasiQuoter { quoteExp = \s -> do
    rs <- 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 fp = do
    rs <- settings
    shakespeareFile rs fp


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

textFileReload :: FilePath -> Q Exp
textFileReload fp = do
    rs <- settings
    shakespeareFileReload rs 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 = do
  toTExp <- [|toText|]
  wrapExp <- [|id|]
  unWrapExp <- [|id|]
  return $ defaultShakespeareSettings { toBuilder = toTExp
  , wrap = wrapExp
  , unwrap = unWrapExp
  , varChar = '~'
  , urlChar = '*'
  , intChar = '&'
  , justVarInterpolation = 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 { quoteExp = \s -> do
    rs <- codegenSettings
    render <- [|toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` 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 { quoteExp = \s -> do
    rs <- codegenSettings
    render <- [|TL.toStrict . toLazyText|]
    rendered <- shakespeareFromString rs { justVarInterpolation = True } s
    return (render `AppE` rendered)
    }

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

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