-- SPDX-FileCopyrightText: 2022 Sarah Vaupel <sarah.vaupel@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Servant.Client.Core.BaseUrl.Instances
  () where

import ClassyPrelude

import Database.Persist
import Database.Persist.Sql

import Servant.Client.Core.BaseUrl

import qualified Data.Text.Encoding as Text

import Control.Arrow (left)

import Data.Swagger hiding (Scheme(..))
import Data.Swagger.Internal.Schema (named)

import Control.Lens
  
import Servant.Docs (ToSample(..))


parseBaseUrl' :: Text -> Either Text BaseUrl
parseBaseUrl' = left tshow . parseBaseUrl . unpack
  
instance PersistField BaseUrl where
  toPersistValue = PersistText . pack . showBaseUrl
  fromPersistValue (PersistText t) = parseBaseUrl' t
  fromPersistValue (PersistByteString bs) = parseBaseUrl' <=< left tshow $ Text.decodeUtf8' bs
  fromPersistValue _ = Left "Unexpected type when converting to BaseUrl"

instance PersistFieldSql BaseUrl where
  sqlType _ = SqlString

instance ToParamSchema BaseUrl where
  toParamSchema _ = mempty
    & type_ ?~ SwaggerString

instance ToSchema BaseUrl where
  declareNamedSchema = pure . named "BaseUrl" . paramSchemaToSchema
    
instance ToSample BaseUrl where
  toSamples _
    = [ ("Without path"    , BaseUrl Https "example.invalid" 443 "")
      , ("With path"       , BaseUrl Https "example.invalid" 443 "/api")
      , ("With custom port", BaseUrl Https "example.invalid" 8443 "")
      ]
