{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module PyF
(f,
f',
fIO,
fString,
fBuilder,
fLazyText,
fStrictText,
fWithDelimiters,
f'WithDelimiters,
fIOWithDelimiters,
fStringWithDelimiters,
fBuilderWithDelimiters,
fLazyTextWithDelimiters,
fStrictTextWithDelimiters,
runFormat,
format,
sformat,
bprint,
fprint,
hprint)
where
import Language.Haskell.TH.Quote (QuasiQuoter(..))
import qualified PyF.Internal.QQ as QQ
import Formatting (runFormat, format, sformat, bprint, fprint, hprint)
import qualified Formatting as F
import Language.Haskell.TH
import qualified Data.Text.Lazy as LText
import qualified Data.Text as SText
import qualified Data.Text.Lazy.Builder as Builder
templateF :: (Char, Char) -> String -> QuasiQuoter
templateF delimiters fName = QuasiQuoter {
quoteExp = QQ.toExp delimiters
, quotePat = err "pattern"
, quoteType = err "type"
, quoteDec = err "declaration"
}
where
err name = error (fName ++ ": This QuasiQuoter can not be used as a " ++ name ++ "!")
f :: QuasiQuoter
f = templateF pythonDelimiters "f"
fWithDelimiters :: (Char, Char) -> QuasiQuoter
fWithDelimiters delimiters = templateF delimiters "fWithDelimiters"
f' :: QuasiQuoter
f' = wrapQQ (templateF pythonDelimiters "f'") (VarE 'magicFormat)
f'WithDelimiters :: (Char, Char) -> QuasiQuoter
f'WithDelimiters delimiters = templateF delimiters "f'WithDelimiters"
wrapQQ :: QuasiQuoter -> Exp -> QuasiQuoter
wrapQQ qq wrap = qq {
quoteExp = \s -> do
e <- quoteExp qq s
pure (AppE wrap e)
}
class MagicFormat t where
magicFormat :: F.Format t t -> t
instance MagicFormat (IO ()) where
magicFormat = F.fprint
instance MagicFormat [Char] where
magicFormat = F.formatToString
instance MagicFormat SText.Text where
magicFormat = F.sformat
instance MagicFormat LText.Text where
magicFormat = F.format
instance MagicFormat Builder.Builder where
magicFormat = F.bprint
fIO, fString, fStrictText, fLazyText, fBuilder :: QuasiQuoter
fIOWithDelimiters, fStringWithDelimiters, fStrictTextWithDelimiters, fLazyTextWithDelimiters, fBuilderWithDelimiters :: (Char, Char) -> QuasiQuoter
fIO = fIOWithDelimiters pythonDelimiters
fString = fStringWithDelimiters pythonDelimiters
fStrictText = fStrictTextWithDelimiters pythonDelimiters
fLazyText = fLazyTextWithDelimiters pythonDelimiters
fBuilder = fBuilderWithDelimiters pythonDelimiters
pythonDelimiters :: (Char, Char)
pythonDelimiters = ('{', '}')
fIOWithDelimiters delimiters = wrapQQ (templateF delimiters "fIO") (VarE 'F.fprint)
fStringWithDelimiters delimiters = wrapQQ (templateF delimiters "fString") (VarE 'F.formatToString)
fStrictTextWithDelimiters delimiters = wrapQQ (templateF delimiters "fStrictTeext") (VarE 'F.sformat)
fLazyTextWithDelimiters delimiters = wrapQQ (templateF delimiters "fLazy") (VarE 'F.sformat)
fBuilderWithDelimiters delimiters = wrapQQ (templateF delimiters "fBuilder") (VarE 'F.bprint)