{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Define servant servers from record types. Generics for the win.
--
-- The usage is simple, if you only need a collection of routes.  First you
-- define a record with field types prefixed by a parameter `route`:
--
-- @
-- data Routes route = Routes
--     { _get :: route :- Capture "id" Int :> Get '[JSON] String
--     , _put :: route :- ReqBody '[JSON] Int :> Put '[JSON] Bool
--     }
--   deriving ('Generic')
-- @
--
-- You can get a 'Proxy' of the server using
--
-- @
-- api :: Proxy (ToServantApi Routes)
-- api = genericApi (Proxy :: Proxy Routes)
-- @
--
-- Using 'genericApi' is better as it checks that instances exists,
-- i.e. you get better error messages than simply using 'Proxy' value.
--
-- __Note:__ in 0.14 series this module isn't re-exported from 'Servant.API'.
--
-- "Servant.API.Generic" is based on @servant-generic@ package by
-- [Patrick Chilton](https://github.com/chpatrick)
--
-- @since 0.14.1
module Servant.API.Generic
  ( GenericMode (..)
  , GenericServant
  , ToServant
  , toServant
  , fromServant

    -- * AsApi
  , AsApi
  , ToServantApi
  , genericApi

    -- * Utility
  , GServantProduct

    -- * re-exports
  , Generic (Rep)
  )
where

-- Based on servant-generic licensed under MIT License
--
-- Copyright (c) 2017 Patrick Chilton
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in all
-- copies or substantial portions of the Software.
--
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic (..), K1 (..), M1 (..), (:*:) (..))

import Servant.API.Alternative

-- | A constraint alias, for work with 'mode' and 'routes'.
type GenericServant routes mode = (GenericMode mode, Generic (routes mode), GServantProduct (Rep (routes mode)))

-- | A class with a type family that applies an appropriate type family to the @api@
-- parameter.  For example, 'AsApi' will leave @api@ untouched, while
-- @'AsServerT' m@ will produce @'ServerT' api m@.
class GenericMode mode where
  type mode :- api :: Type

infixl 0 :-

-- | Turns a generic product type into a tree of `:<|>` combinators.
type ToServant routes mode = GToServant (Rep (routes mode))

type ToServantApi routes = ToServant routes AsApi

-- | See `ToServant`, but at value-level.
toServant
  :: GenericServant routes mode
  => routes mode
  -> ToServant routes mode
toServant = gtoServant . from

-- | Inverse of `toServant`.
--
-- This can be used to turn 'generated' values such as client functions into records.
--
-- You may need to provide a type signature for the /output/ type (your record type).
fromServant
  :: GenericServant routes mode
  => ToServant routes mode
  -> routes mode
fromServant = to . gfromServant

-- | A type that specifies that an API record contains an API definition. Only useful at type-level.
data AsApi

instance GenericMode AsApi where
  type AsApi :- api = api

-- | Get a 'Proxy' of an API type.
genericApi
  :: GenericServant routes AsApi
  => Proxy routes
  -> Proxy (ToServantApi routes)
genericApi _ = Proxy

-------------------------------------------------------------------------------
-- Class
-------------------------------------------------------------------------------

class GServantProduct f where
  type GToServant f
  gtoServant :: f p -> GToServant f
  gfromServant :: GToServant f -> f p

instance GServantProduct f => GServantProduct (M1 i c f) where
  type GToServant (M1 i c f) = GToServant f
  gtoServant = gtoServant . unM1
  gfromServant = M1 . gfromServant

instance (GServantProduct l, GServantProduct r) => GServantProduct (l :*: r) where
  type GToServant (l :*: r) = GToServant l :<|> GToServant r
  gtoServant (l :*: r) = gtoServant l :<|> gtoServant r
  gfromServant (l :<|> r) = gfromServant l :*: gfromServant r

instance GServantProduct (K1 i c) where
  type GToServant (K1 i c) = c
  gtoServant = unK1
  gfromServant = K1
