{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# 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.Semigroup (Semigroup(..))
import Data.String (IsString(..))
import System.IO (IO)
import Prelude (error, (+), (*))
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.Types as HTTP
import qualified Network.URI as URI
import qualified Network.Wai.Handler.Warp as Warp
import qualified Web.HttpApiData as Web
import           Test.Hspec.Wai (get, matchStatus, post, shouldRespondWith, with)

-- import Test.Hspec
-- import Test.Tasty.HUnit
import Test.Hspec
import Test.Hspec.Wai
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

-- cli0_get :!: cli0_post = command api0

api1
 =   segment "time"
 <.> capture @Time.TimeZone "timezone"
 <.> endpoint @TL.Text @PlainText HTTP.methodGet
 
 <!> segment "date"
 <.> endpoint @TL.Text @PlainText HTTP.methodGet
 
 <!> segment "echo"
 <.> captureAll
 <.> endpoint @TL.Text @PlainText HTTP.methodGet
 
 <!> segment "succ"
 <.> capture @Int "n"
 <.> endpoint @Int @PlainText HTTP.methodGet
 
 <!>
 segment "info"
 <.> (  endpoint @TL.Text @PlainText HTTP.methodHead
    <!> endpoint @TL.Text @PlainText HTTP.methodGet
     )
instance MimeSerialize PlainText () where
	mimeSerialize _mt = fromString . show
instance MimeUnserialize PlainText () where
	mimeUnserialize _mt s =
		case s of
		 "()" -> Right ()
		 _ -> Left "cannot parse ()"

instance MimeSerialize PlainText Int where
	mimeSerialize _mt = BSL.fromStrict . Text.encodeUtf8 . Text.pack . show
instance MimeUnserialize PlainText Int 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
 ) = runCommand api1

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

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

hspec =
	testSpecs $
	with (return rou1) $
		it "allows running arbitrary monads" $ do
			get "/date" `shouldRespondWith` 200