{-# LANGUAGE TemplateHaskell #-}
module Data.String.Interpolate
( i, iii )
where
import Data.Proxy
import Language.Haskell.Meta.Parse ( parseExp )
import Language.Haskell.TH
import Language.Haskell.TH.Quote ( QuasiQuoter(..) )
import Data.String.Interpolate.Conversion
( build, 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 = case parseExp s of
Left _ -> fail $ "Data.String.Interpolate.i: parse error in expression: " ++ s
Right e -> pure e