packages feed

servant-checked-exceptions-0.1.0.0: example/Api.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Api where

import Data.Aeson
       (FromJSON(parseJSON), ToJSON(toJSON), Value, withText)
import Data.Aeson.Types (Parser)
-- import Data.Proxy (Proxy(Proxy))
import Data.String (IsString)
import Data.Text (unpack)
import Servant.API (Capture, JSON, Post, (:>), (:<|>))
-- import Servant.Client (Client, ClientM, client)
-- import Servant.Docs
--        (ToParam(toParam), ToSample(toSamples), docs, markdown)
-- import Servant.Docs.Internal
--        (DocQueryParam(DocQueryParam), ParamKind(Normal))
import Text.Read (readMaybe)
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)

import Servant.Checked.Exceptions (Throws)

---------
-- API --
---------

type Api = ApiStrictSearch :<|> ApiLaxSearch

type ApiStrictSearch =
  "strict-search" :>
  Capture "query" SearchQuery :>
  Throws BadSearchTermErr :>
  Throws IncorrectCapitalization :>
  Post '[JSON] SearchResponse

type ApiLaxSearch =
  "lax-search" :>
  Capture "query" SearchQuery :>
  Throws BadSearchTermErr :>
  Post '[JSON] SearchResponse

------------------------------
-- Parameters and Responses --
------------------------------

newtype SearchQuery = SearchQuery
  { unSearchQuery :: String
  } deriving ( Eq
             , FromHttpApiData
             , FromJSON
             , IsString
             , Ord
             , Read
             , Show
             , ToHttpApiData
             , ToJSON
             )

newtype SearchResponse = SearchResponse
  { unSearchResponse :: String
  } deriving ( Eq
             , FromHttpApiData
             , FromJSON
             , IsString
             , Ord
             , Read
             , Show
             , ToHttpApiData
             , ToJSON
             )

------------
-- Errors --
------------

data BadSearchTermErr = BadSearchTermErr deriving (Eq, Read, Show)

instance ToJSON BadSearchTermErr where
  toJSON :: BadSearchTermErr -> Value
  toJSON = toJSON . show

instance FromJSON BadSearchTermErr where
  parseJSON :: Value -> Parser BadSearchTermErr
  parseJSON = withText "BadSearchTermErr" $
    maybe (fail "could not parse as BadSearchTermErr") pure . readMaybe . unpack

data IncorrectCapitalization = IncorrectCapitalization deriving (Eq, Read, Show)

instance ToJSON IncorrectCapitalization where
  toJSON :: IncorrectCapitalization -> Value
  toJSON = toJSON . show

instance FromJSON IncorrectCapitalization where
  parseJSON :: Value -> Parser IncorrectCapitalization
  parseJSON = withText "IncorrectCapitalization" $
    maybe (fail "could not parse as IncorrectCapitalization") pure . readMaybe . unpack

----------
-- Port --
----------

port :: Int
port = 8201