QQ.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Traction.QQ (
    savepoint
  , schema
  , sql
  ) where

import           Data.Data (Data)
import           Data.Generics (extQ)
import           Data.Text (Text)
import qualified Data.Text as Text

import           Database.PostgreSQL.Simple.SqlQQ (sql)

import           Language.Haskell.TH
import           Language.Haskell.TH.Quote

import qualified Prelude

import           Traction.Sql (newSchema, newSavepoint)
import           Traction.Prelude

schema :: QuasiQuoter
schema =
  QuasiQuoter {
    quoteExp = \s -> case newSchema (Text.pack s) of
      Nothing ->
        Prelude.error "Failed to parse savepoint"
      Just v ->
        dataExp v
  , quotePat = Prelude.error "not able to qq pats"
  , quoteType = Prelude.error "not able to qq types"
  , quoteDec = Prelude.error "not able to qq decs"
  }

savepoint :: QuasiQuoter
savepoint =
  QuasiQuoter {
    quoteExp = \s -> case newSavepoint (Text.pack s) of
      Nothing ->
        Prelude.error "Failed to parse savepoint"
      Just v ->
        dataExp v
  , quotePat = Prelude.error "not able to qq pats"
  , quoteType = Prelude.error "not able to qq types"
  , quoteDec = Prelude.error "not able to qq decs"
  }

dataExp :: Data a => a -> Q Exp
dataExp a =
  dataToExpQ (const Nothing `extQ` textExp) a

textExp :: Text -> Maybe ExpQ
textExp =
  pure . appE (varE 'Text.pack) . litE . StringL . Text.unpack