{-# LANGUAGE TemplateHaskell #-}
module Data.String.Interpolate
( i, iii )
where
import Data.Proxy
import qualified Language.Haskell.Exts.Extension as Ext
import Language.Haskell.Exts.Parser
( ParseMode(..), ParseResult(..), defaultParseMode, parseExpWithMode )
import Language.Haskell.Meta ( ToExp(..) )
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Data.String.Interpolate.Conversion ( build, chompSpaces, finalize, interpolate, ofString )
import Data.String.Interpolate.Parse ( InterpSegment(..), dosToUnix, parseInterpSegments )
i :: QuasiQuoter
i = QuasiQuoter
{ quoteExp = toExp . parseInterpSegments . dosToUnix
, quotePat = err "pattern"
, quoteType = err "type"
, quoteDec = err "declaration"
}
where err name = error ("Data.String.Interpolate.i: This QuasiQuoter cannot be used as a " ++ name)
toExp :: Either String [InterpSegment] -> Q Exp
toExp parseResult = case parseResult of
Left msg -> fail $ "Data.String.Interpolate.i: " ++ msg
Right segs -> emitBuildExp segs
emitBuildExp :: [InterpSegment] -> Q Exp
emitBuildExp segs = [|finalize Proxy $(go segs)|]
where go [] = [|ofString Proxy ""|]
go (Verbatim str : rest) =
[|build Proxy (ofString Proxy str) $(go rest)|]
go (Expression expr : rest) =
[|build Proxy (interpolate Proxy $(reifyExpression expr)) $(go rest)|]
iii :: QuasiQuoter
iii = QuasiQuoter
{ quoteExp = toExp . parseInterpSegments . dosToUnix
, quotePat = err "pattern"
, quoteType = err "type"
, quoteDec = err "declaration"
}
where err name = error ("Data.String.Interpolate.iii: This QuasiQuoter cannot be used as a " ++ name)
toExp :: Either String [InterpSegment] -> Q Exp
toExp parseResult = case parseResult of
Left msg -> fail $ "Data.String.Interpolate.iii: " ++ msg
Right segs -> emitBuildExp segs
emitBuildExp :: [InterpSegment] -> Q Exp
emitBuildExp segs = [|chompSpaces (finalize Proxy $(go segs))|]
where go [] = [|ofString Proxy ""|]
go (Verbatim str : rest) =
[|build Proxy (ofString Proxy str) $(go rest)|]
go (Expression expr : rest) =
[|build Proxy (interpolate Proxy $(reifyExpression expr)) $(go rest)|]
reifyExpression :: String -> Q Exp
reifyExpression s = do
exts <- (fmap . fmap) (Ext.parseExtension . show) extsEnabled
parseMode <- pure (defaultParseMode { extensions = exts })
case parseExpWithMode parseMode s of
ParseFailed _ err -> fail $
"Data.String.Interpolate.i: got error: '" ++ err ++ "' while parsing expression: " ++ s
ParseOk e -> pure (toExp e)