{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}

module Api where

import Data.Aeson
       (FromJSON(parseJSON), ToJSON(toJSON), Value, withText)
import Data.Aeson.Types (Parser)
import Data.String (IsString)
import Data.Text (unpack)
import Network.HTTP.Types (Status, status400, status404)
import Servant.API (Capture, JSON, Post, (:>), (:<|>))
import Text.Read (readMaybe)
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)

import Servant.Checked.Exceptions (NoThrow, Throws)
import Servant.Checked.Exceptions.Internal.Servant.API (ErrStatus(toErrStatus))

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

-- | This is our main 'Api' type.  We will create a server, a client, and
-- documentation for this api.
--
-- This api is composed of three routes, 'ApiStrictSearch', 'ApiLaxSearch', and
-- 'ApiNoErrSearch'.
type Api = ApiStrictSearch :<|> ApiLaxSearch :<|> ApiNoErrSearch

-- | This is a strict search api.  You pass it a @\"query\"@, and it returns a
-- 'SearchResponse'.  It potentially returns a 'BadSearchTermErr' if your query
-- is not the string @\"hello\"@.  It returns an 'IncorrectCapitialization'
-- error if your query is not capitalized like @\"Hello\"@.
--
-- Notice how we are using 'Throws' to indicate we will potentially throw an
-- error.  Also, notice how we can list multiple 'Throws'.
type ApiStrictSearch =
  "strict-search" :>
  Capture "query" SearchQuery :>
  Throws BadSearchTermErr :>
  Throws IncorrectCapitalization :>
  Post '[JSON] SearchResponse

-- | This is similar to 'ApiStrictSearch', but it doesn't force the query to be
-- capitalized correctly.  It only returns a 'BadSearchTermErr'.
type ApiLaxSearch =
  "lax-search" :>
  Capture "query" SearchQuery :>
  Throws BadSearchTermErr :>
  Post '[JSON] SearchResponse

-- | This is similar to 'ApiLaxSearch', but it doesn't force the query to use
-- correct terms.  It does not return an error.
type ApiNoErrSearch =
  "no-err-search" :>
  Capture "query" SearchQuery :>
  NoThrow :>
  Post '[JSON] SearchResponse

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

-- | This 'SearchQuery' type is just a newtype wrapper around a 'String'.
newtype SearchQuery = SearchQuery
  { unSearchQuery :: String
  } deriving ( Eq
             , FromHttpApiData
             , FromJSON
             , IsString
             , Ord
             , Read
             , Show
             , ToHttpApiData
             , ToJSON
             )

-- | This 'SearchResponse' type is just a newtype wrapper around a 'String'.
newtype SearchResponse = SearchResponse
  { unSearchResponse :: String
  } deriving ( Eq
             , FromHttpApiData
             , FromJSON
             , IsString
             , Ord
             , Read
             , Show
             , ToHttpApiData
             , ToJSON
             )

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

-- | This error is returned when the search query is not the string @\"hello\"@.
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

instance ErrStatus BadSearchTermErr where
  toErrStatus :: BadSearchTermErr -> Status
  toErrStatus _ = status404

-- | This error is returned when the search query is @\"hello\"@, but it is not
-- capitalized correctly.  For example, the search query @\"hello\"@ will
-- return an 'IncorrectCapitialization' error.  However, the search query
-- @\"Hello\"@ will return a success.
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

instance ErrStatus IncorrectCapitalization where
  toErrStatus :: IncorrectCapitalization -> Status
  toErrStatus _ = status400

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

-- | The port to run the server on.
port :: Int
port = 8201