This page demonstrates a trick I came up with which is defining IsString
for Q (TExp a)
, where a
is lift
-able. It allows you to write $$("...")
and have the string parsed at compile-time.
This offers a light-weight way to enforce compile-time constraints. It’s basically OverloadedStrings
with static checks.
This trick works already in old GHC versions.
{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}
import Network.URI
import Path
import PATHTH
import SHA256TH
import URITH
uri :: URI
uri = $$("https://releases.hashicorp.com/vault/1.2.2/vault_1.2.2_linux_amd64.zip")
sha256 :: SHA256
sha256 = $$("7725b35d9ca8be3668abe63481f0731ca4730509419b4eb29fa0b0baa4798458")
home :: Path Abs Dir
home = $$("/home/chris")
Scroll down to see the modules PATHTH
, SHA256TH
and URITH
.
This is more light-weight and overloaded than, e.g.
which requires stating the name of the quoter you want (sometimes you’d rather not), requires the QuasiQuotes
extension, and leaves syntax highlighters not sure how to highlight your content properly.
It’d be nice to relax GHC’s parser a little to support $$"..."
to mean the same thing. This wouldn’t conflict with any existing syntax that I am aware of, or of any existing plans or proposals.
{-# LANGUAGE FlexibleInstances #-}
module PATHTH where
import Data.String (IsString(..))
import Language.Haskell.TH.Syntax (Q, TExp(..), lift)
import Path
instance IsString (Q (TExp (Path Rel Dir))) where
fromString = fmap TExp . mkRelDir
instance IsString (Q (TExp (Path Abs Dir))) where
fromString = fmap TExp . mkAbsDir
instance IsString (Q (TExp (Path Rel File))) where
fromString = fmap TExp . mkRelFile
instance IsString (Q (TExp (Path Abs File))) where
fromString = fmap TExp . mkAbsFile
{-# LANGUAGE DeriveLift, FlexibleInstances, TemplateHaskell #-}
module SHA256TH where
import Data.ByteString (ByteString)
import qualified Data.ByteString as S
import qualified Data.ByteString.Base16 as Hex
import Data.String
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Q, TExp(..), Lift(..))
newtype SHA256 = SHA256 ByteString deriving (Eq, Ord, Lift)
instance IsString (Q (TExp SHA256)) where
fromString i =
if length i == 64
then case Hex.decode (fromString i) of
(result, wrong)
| S.null wrong -> fmap TExp (lift (SHA256 result))
_ -> fail "Invalid SHA256 format."
else fail "Incorrect length for SHA256."
{-# LANGUAGE NamedFieldPuns, FlexibleInstances, TemplateHaskell #-}
module URITH where
import Data.String (IsString(..))
import Language.Haskell.TH.Syntax (Q, TExp(..), lift)
import Network.URI (URI(..), parseURI, URIAuth(..))
instance IsString (Q (TExp URI)) where
fromString i =
case parseURI i of
Nothing -> fail ("Invalid URI: " ++ show i)
Just uri -> liftURI uri
liftURI :: URI -> Q (TExp URI)
liftURI URI {uriScheme, uriAuthority, uriPath, uriQuery, uriFragment} =
fmap TExp [|URI {uriScheme, uriAuthority = $(mauthority), uriPath, uriQuery, uriFragment}|]
where
mauthority = maybe [|Nothing|] liftAuthority uriAuthority
liftAuthority URIAuth {uriUserInfo, uriRegName, uriPort} =
[|Just (URIAuth {uriUserInfo, uriRegName, uriPort})|]