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

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

module Network.URI.Instances
  (
  ) where

import ClassyPrelude

import Network.URI
import Network.URI.Static
import Web.HttpApiData

import Data.Swagger
import Data.Swagger.Internal.Schema

import Data.Proxy

import Servant.Docs

import qualified Data.Aeson as Aeson

import Control.Monad.Fail (MonadFail(..))

import Database.Persist
import Database.Persist.Sql


instance ToHttpApiData URI where
  toQueryParam = pack . ($ mempty) . uriToString id

instance FromHttpApiData URI where
  parseQueryParam = maybe (Left "Could not parse URIReference") Right . parseURIReference . unpack

instance ToParamSchema URI where
  toParamSchema _ = toParamSchema $ Proxy @String

instance ToSchema URI where
  declareNamedSchema = pure . named "URI" . paramSchemaToSchema

instance ToSample URI where
  toSamples _ = samples
    [ [uri|https://example.invalid/path/to/resource?key1=val1&key1=val2&key2=val3#fragment|]
    , [relativeReference|unAnchored/path/to/resource|]
    , [relativeReference|/anchored/path/to/resource|]
    ]

instance Aeson.ToJSON URI where
  toJSON = Aeson.String . pack . ($ mempty) . uriToString id
instance Aeson.FromJSON URI where
  parseJSON = Aeson.withText "URI" $ maybe (fail "Could not parse URI") return . parseURIReference . unpack

instance PersistField URI where
  toPersistValue = PersistText . pack . ($ mempty) . uriToString id 
  fromPersistValue (PersistText t) = maybe (Left "Could not parse URI") return . parseURIReference $ unpack t
  fromPersistValue v = Left $ "Failed to parse Haskell type `URI`; expected text from database but received: " <> tshow v <> "."
instance PersistFieldSql URI where
  sqlType _ = SqlString