{-# LANGUAGE QuasiQuotes     #-}
{-# LANGUAGE TemplateHaskell #-}

-- |
-- Module      :  Data.ByteArray.HexString.TH
-- Copyright   :  Aleksandr Krupenkin 2016-2021
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  unportable
--
-- Hex string template haskell helpers.
--

module Data.ByteArray.HexString.TH where

import           Data.ByteArray.HexString.Internal (HexString)
import           Data.String                       (fromString)
import           Language.Haskell.TH.Quote         (QuasiQuoter (..), quoteFile)

hexFrom :: QuasiQuoter
hexFrom :: QuasiQuoter
hexFrom = QuasiQuoter -> QuasiQuoter
quoteFile QuasiQuoter
hex

hex :: QuasiQuoter
hex :: QuasiQuoter
hex = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = \String
s -> [|fromString s :: HexString|]
    , quotePat :: String -> Q Pat
quotePat = String -> Q Pat
forall a. HasCallStack => a
undefined
    , quoteType :: String -> Q Type
quoteType = String -> Q Type
forall a. HasCallStack => a
undefined
    , quoteDec :: String -> Q [Dec]
quoteDec = String -> Q [Dec]
forall a. HasCallStack => a
undefined
    }