This gist demonstrates a trick I came up with which is defining
IsString for Q (TExp a), where a is lift-able. This 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 existing (old) GHCs.
| {-# 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") |
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 | |
| 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})|] |