{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hspec.API where

import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Bool
import Data.Either (Either(..))
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Int (Int)
import Data.Maybe (Maybe(..))
import Data.Proxy (Proxy(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import Prelude (error, (+), (*))
import System.IO (IO)
import Text.Read (readMaybe)
import Text.Show (Show(..))
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Data.Time as Time
import qualified Network.HTTP.Client as Client
import qualified Network.HTTP.Media as Media
import qualified Network.HTTP.Types as HTTP
import qualified Network.URI as URI
import qualified Network.Wai.Handler.Warp as Warp
import qualified Test.Hspec.Wai as Wai
import qualified Web.HttpApiData as Web

import Test.Hspec
import Test.Tasty
import Test.Tasty.Hspec

import Symantic.HTTP

-- * Type 'API0'
data API0
 =   API0_Date Time.Day
 |   API0_Time Time.ZonedTime
 |   API0_Reset Bool
 deriving (Show)
instance IsString Time.TimeZone where
	fromString s = case s of
	 "CET"  -> Time.TimeZone (1*60) False "CET"
	 "CEST" -> Time.TimeZone (2*60) False "CEST"
	 _ -> error "unknown TimeZone"
instance Web.FromHttpApiData Time.TimeZone where
	parseUrlPiece = \case
	 "CET"  -> Right $ Time.TimeZone (1*60) True  "CET"
	 "CEST" -> Right $ Time.TimeZone (2*60) False "CEST"
	 _ -> Left "unknown TimeZone"
instance Web.ToHttpApiData Time.TimeZone where
	toUrlPiece (Time.TimeZone _s _b n) = Text.pack n

manager :: IO Client.Manager
manager = Client.newManager Client.defaultManagerSettings
Just baseURI = URI.parseURI "http://localhost:8080"
cliEnv = clientEnv <$> manager <*> pure baseURI

api1
 =   "time" </> capture @Time.TimeZone "timezone"
            <.> get @TL.Text @PlainText

 <!> "date" </> get @TL.Text @PlainText
 
 <!> "echo" </> captureAll
            <.> get @TL.Text @PlainText
 
 <!> "succ" </> capture @Int "n"
            <.> get @Int @PlainText
 
 <!> "info" </> (  head @TL.Text @PlainText
               <!> get  @TL.Text @PlainText
                )
instance MimeSerialize () PlainText where
	mimeSerialize _mt = fromString . show
instance MimeUnserialize () PlainText where
	mimeUnserialize _mt s =
		case s of
		 "()" -> Right ()
		 _ -> Left "cannot parse ()"

instance MimeSerialize Int PlainText where
	mimeSerialize _mt = BSL.fromStrict . Text.encodeUtf8 . Text.pack . show
instance MimeUnserialize Int PlainText where
	mimeUnserialize _mt s =
		case readMaybe $ TL.unpack $ TL.decodeUtf8 s of
		 Just n -> Right n
		 _ -> Left "cannot parse Int"

lay1 = layout api1

(api1_time :!:
 api1_date :!:
 api1_echo :!:
 api1_succ :!:
 (api1_info_head :!:
  api1_info_get)
 ) = client api1

srv1 = server api1 $
	route_time :!:
	route_date :!:
	route_echo :!:
	route_succ :!:
	route_info
	where
	route_time tz (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			time <- Time.utcToZonedTime tz <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show time <> "\n"
	
	route_date (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			date <- Time.utctDay <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show date <> "\n"
	
	route_echo path (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] $ TL.pack $ show path <> "\n"
	
	route_succ n (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			res $ respond status200 [] $ n+1
	
	route_info = route_head :!: route_get
		where
		route_head (ServerResponseArg respond) =
			ServerResponse $ \req res -> do
				res $ respond (HTTP.mkStatus 201 "") [] $ TL.pack $ show req <> "\n"
		
		route_get (ServerResponseArg respond) =
			ServerResponse $ \req res -> do
				res $ respond status200 [] $ TL.pack $ show req <> "\n"

warp1 :: IO ()
warp1 = Warp.run 8080 srv1

api2 = "ti"</>"me" </> get @TL.Text @PlainText
   <!> "da"</>"te" </> get @TL.Text @PlainText

srv2 = server api2 $
	route_time :!:
	route_date
	where
	route_time (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			time <- Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show time <> "\n"
	
	route_date (ServerResponseArg respond) =
		ServerResponse $ \_req res -> do
			date <- Time.utctDay <$> Time.getCurrentTime
			res $ respond status200 [] $
				TL.pack $ show date <> "\n"

warp2 :: IO ()
warp2 = Warp.run 8080 srv2

hspec =
	testSpecs $
	Wai.with (return srv2) $ do
		it "respond with success" $ do
			Wai.get "/da/te"
			 `Wai.shouldRespondWith` 200
		it "checks Accept header" $ do
			Wai.request HTTP.methodGet "/da/te"
			 [ (HTTP.hAccept, Media.renderHeader $ mimeType $ Proxy @OctetStream)
			 ] ""
			 `Wai.shouldRespondWith` 406