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

module Main where

import Data.Monoid ((<>))
import Data.Proxy (Proxy(Proxy))
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Options.Applicative
       (Parser, (<**>), argument, execParser, fullDesc, help, helper, info, long,
        metavar, progDesc, short, str, switch)
import Servant.API ((:<|>)((:<|>)))
import Servant.Client
       (BaseUrl(BaseUrl), ClientEnv, ClientM, Scheme(Http),
        client, mkClientEnv, runClientM)

import Servant.Checked.Exceptions (Envelope, emptyEnvelope, catchesEnvelope)

import Api
       (Api, BadSearchTermErr(BadSearchTermErr),
        IncorrectCapitalization(IncorrectCapitalization),
        SearchQuery(SearchQuery), SearchResponse(SearchResponse), port)

-----------------------------------------
-- Clients generated by servant-client --
-----------------------------------------

-- We generate the client functions just like normal.  Note that when we use
-- 'Throws' or 'NoThrow', the client functions get generated with the
-- 'Envelope' type.

strictSearch
  :: SearchQuery
  -> ClientM (Envelope '[BadSearchTermErr, IncorrectCapitalization] SearchResponse)
laxSearch
  :: SearchQuery
  -> ClientM (Envelope '[BadSearchTermErr] SearchResponse)
noErrSearch
  :: SearchQuery
  -> ClientM (Envelope '[] SearchResponse)
strictSearch :<|> laxSearch :<|> noErrSearch = client (Proxy :: Proxy Api)

--------------------------------------
-- Command-line options and parsers --
--------------------------------------

-- The following are needed for using optparse-applicative to parse command
-- line arguments.  Most people shouldn't need to worry about how this works.

data Options = Options { query :: String, useStrict :: Bool, useNoErr :: Bool }

queryParser :: Parser String
queryParser = argument str (metavar "QUERY")

useStrictParser :: Parser Bool
useStrictParser =
  switch $
    long "strict" <> short 's' <> help "Whether or not to use the strict api"

useNoErrParser :: Parser Bool
useNoErrParser =
  switch $
    long "no-err" <>
    short 'n' <>
    help "Whether or not to use the api that does not return an error"

commandParser :: Parser Options
commandParser = Options <$> queryParser <*> useStrictParser <*> useNoErrParser

-------------------------------------------------------------------------
-- Command Runners (these use the clients generated by servant-client) --
-------------------------------------------------------------------------

-- | This function uses the 'strictSearch' function to send a 'SearchQuery' to
-- the server.
--
-- Note how 'catchesEnvelope' is used to handle the two error reponses and the
-- success response.
runStrict :: ClientEnv -> String -> IO ()
runStrict clientEnv query = do
  eitherRes <- runClientM (strictSearch $ SearchQuery query) clientEnv
  case eitherRes of
    Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr
    Right env ->
      putStrLn $
        catchesEnvelope
          ( \BadSearchTermErr -> "the search term was not \"Hello\""
          , \IncorrectCapitalization -> "the search term was not capitalized correctly"
          )
          (\(SearchResponse searchResponse) -> "Success: " <> searchResponse)
          env

-- | This function uses the 'laxSearch' function to send a 'SearchQuery' to
-- the server.
runLax :: ClientEnv -> String -> IO ()
runLax clientEnv query = do
  eitherRes <- runClientM (laxSearch $ SearchQuery query) clientEnv
  case eitherRes of
    Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr
    Right env ->
      putStrLn $
        catchesEnvelope
          (\BadSearchTermErr -> "the search term was not \"Hello\"")
          (\(SearchResponse searchResponse) -> "Success: " <> searchResponse)
          env

-- | This function uses the 'noErrSearch' function to send a 'SearchQuery' to
-- the server.
runNoErr :: ClientEnv -> String -> IO ()
runNoErr clientEnv query = do
  eitherRes <- runClientM (noErrSearch $ SearchQuery query) clientEnv
  case eitherRes of
    Left servantErr -> putStrLn $ "Got a ServantErr: " <> show servantErr
    Right env -> do
      let (SearchResponse res) = emptyEnvelope env
      putStrLn $ "Success: " <> res

-- | Run 'runStrict',  'runLax', or 'runNoErr' depending on the command line options.
run :: ClientEnv -> Options -> IO ()
run clientEnv Options{query, useStrict = True, useNoErr = _} = runStrict clientEnv query
run clientEnv Options{query, useStrict = _, useNoErr = True} = runNoErr clientEnv query
run clientEnv Options{query, useStrict = _, useNoErr = _} = runLax clientEnv query

----------
-- Main --
----------

main :: IO ()
main = do
  manager <- newManager defaultManagerSettings
  let clientEnv = mkClientEnv manager baseUrl
  options <- execParser opts
  run clientEnv options
  where
    opts = info (commandParser <**> helper) $
      fullDesc <>
      progDesc "Send the QUERY to the example server and print the response."

baseUrl :: BaseUrl
baseUrl = BaseUrl Http "localhost" port ""