TH.hs

{-# LANGUAGE TemplateHaskell #-}

-- Module      : Network.PagerDuty.Internal.TH
-- Copyright   : (c) 2013-2015 Brendan Hay <brendan.g.hay@gmail.com>
-- License     : This Source Code Form is subject to the terms of
--               the Mozilla Public License, v. 2.0.
--               A copy of the MPL can be found in the LICENSE file or
--               you can obtain it at http://mozilla.org/MPL/2.0/.
-- Maintainer  : Brendan Hay <brendan.g.hay@gmail.com>
-- Stability   : experimental
-- Portability : non-portable (GHC extensions)

module Network.PagerDuty.Internal.TH
    (
    -- * Requests
      jsonRequest
    , queryRequest

    -- * Compound expressions
    , deriveNullary
    , deriveNullaryWith
    , deriveRecord

    -- * JSON
    , deriveJSON
    , deriveJSONWith

    -- * Lenses
    , makeLens
    , makeFields

    -- * Re-exported generics
    , deriveGeneric

    -- * Re-exported options
    , dropped
    , hyphenated
    , underscored
    ) where

import           Control.Applicative
import           Control.Lens
import qualified Data.Aeson.TH                      as Aeson
import           Data.Aeson.Types
import           Data.ByteString                    (ByteString)
import qualified Data.Text.Encoding                 as Text
import           Generics.SOP.TH
import           Language.Haskell.TH
import           Network.HTTP.Types.QueryLike
import           Network.PagerDuty.Internal.Options
import           Network.PagerDuty.Internal.Query

jsonRequest :: Name -> Q [Dec]
jsonRequest n = concat <$> sequence
    [ makeLenses n
    , deriveJSON n
    , [d|instance QueryLike $(conT n) where toQuery = const []|]
    ]

queryRequest :: Name -> Q [Dec]
queryRequest n = concat <$> sequence
    [ deriveGeneric n
    , makeLenses n
    , [d|instance ToJSON $(conT n) where toJSON = const emptyObject|]
    , [d|instance QueryLike $(conT n) where toQuery = gquery|]
    ]

deriveNullary :: Name -> Q [Dec]
deriveNullary = deriveNullaryWith underscored

deriveNullaryWith :: Options -> Name -> Q [Dec]
deriveNullaryWith o n = concat <$> sequence
    [ deriveJSONWith o n
    , [d|instance QueryValues $(conT n) where queryValues = value . toJSON|]
    ]

deriveRecord :: Name -> Q [Dec]
deriveRecord n = concat <$> sequence
    [ deriveJSON n
    , makeLenses n
    ]

deriveJSON :: Name -> Q [Dec]
deriveJSON = deriveJSONWith underscored

deriveJSONWith :: Options -> Name -> Q [Dec]
deriveJSONWith = Aeson.deriveJSON

makeLens :: String -> Name -> Q [Dec]
makeLens k = makeLensesWith
    $ lensRulesFor [(k, drop 1 k)]
    & simpleLenses .~ True

value :: Value -> [ByteString]
value (String t) = [Text.encodeUtf8 t]
value _          = []