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
= $$("https://releases.hashicorp.com/vault/1.2.2/vault_1.2.2_linux_amd64.zip")
uri
sha256 :: SHA256
= $$("7725b35d9ca8be3668abe63481f0731ca4730509419b4eb29fa0b0baa4798458")
sha256
home :: Path Abs Dir
= $$("/home/chris") home
Scroll down to see the modules PATHTH
,
SHA256TH
and URITH
.
This is more light-weight and overloaded than, e.g.
[quasiquote|...|]
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
= fmap TExp . mkRelDir
fromString instance IsString (Q (TExp (Path Abs Dir))) where
= fmap TExp . mkAbsDir
fromString instance IsString (Q (TExp (Path Rel File))) where
= fmap TExp . mkRelFile
fromString instance IsString (Q (TExp (Path Abs File))) where
= fmap TExp . mkAbsFile fromString
{-# 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)
URI {uriScheme, uriAuthority, uriPath, uriQuery, uriFragment} =
liftURI fmap TExp [|URI {uriScheme, uriAuthority = $(mauthority), uriPath, uriQuery, uriFragment}|]
where
= maybe [|Nothing|] liftAuthority uriAuthority
mauthority URIAuth {uriUserInfo, uriRegName, uriPort} =
liftAuthority |Just (URIAuth {uriUserInfo, uriRegName, uriPort})|] [