module Argo.QuasiQuoter where

import qualified Argo.Decode as Decode
import qualified Argo.Result as Result
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Language.Haskell.TH.Quote as QQ
import qualified Language.Haskell.TH.Syntax as TH

value :: QQ.QuasiQuoter
value :: QuasiQuoter
value = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QQ.QuasiQuoter
    { quoteDec :: String -> Q [Dec]
QQ.quoteDec = Q [Dec] -> String -> Q [Dec]
forall a b. a -> b -> a
const (Q [Dec] -> String -> Q [Dec]) -> Q [Dec] -> String -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ String -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"quoteDec"
    , quoteExp :: String -> Q Exp
QQ.quoteExp = String -> Q Exp
quoteExp
    , quotePat :: String -> Q Pat
QQ.quotePat = Q Pat -> String -> Q Pat
forall a b. a -> b -> a
const (Q Pat -> String -> Q Pat) -> Q Pat -> String -> Q Pat
forall a b. (a -> b) -> a -> b
$ String -> Q Pat
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"quotePat"
    , quoteType :: String -> Q Type
QQ.quoteType = Q Type -> String -> Q Type
forall a b. a -> b -> a
const (Q Type -> String -> Q Type) -> Q Type -> String -> Q Type
forall a b. (a -> b) -> a -> b
$ String -> Q Type
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"quoteType"
    }

quoteExp :: String -> TH.Q TH.Exp
quoteExp :: String -> Q Exp
quoteExp String
x = case (Value -> Result Value) -> ByteString -> Result Value
forall a. (Value -> Result a) -> ByteString -> Result a
Decode.decodeWith Value -> Result Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Result Value)
-> (Text -> ByteString) -> Text -> Result Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8 (Text -> Result Value) -> Text -> Result Value
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
x of
    Result.Failure String
e -> String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
    Result.Success Value
y -> Value -> Q Exp
forall t. Lift t => t -> Q Exp
TH.lift Value
y