62 lines
1.8 KiB
Haskell
62 lines
1.8 KiB
Haskell
-- 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
|