{-# LANGUAGE DefaultSignatures #-}

module Web.Hyperbole.Data.Param where

import Data.Aeson (FromJSON, GFromJSON, GToJSON, Options (..), SumEncoding (..), ToJSON, Value (..), Zero, defaultOptions, genericParseJSON, genericToJSON)
import Data.Aeson qualified as A
import Data.Aeson.Types qualified as A
import Data.Bifunctor (first)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Data.Word
import GHC.Exts (IsList (..))
import GHC.Generics
import Text.Read (readMaybe)
import Web.HttpApiData (FromHttpApiData, ToHttpApiData)
import Web.HttpApiData qualified as HttpApiData
import Web.Hyperbole.Data.URI (URI (..), parseURIReference, uriToText)


newtype Param = Param {Param -> Text
text :: Text}
  deriving newtype (Int -> Param -> ShowS
[Param] -> ShowS
Param -> String
(Int -> Param -> ShowS)
-> (Param -> String) -> ([Param] -> ShowS) -> Show Param
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Param -> ShowS
showsPrec :: Int -> Param -> ShowS
$cshow :: Param -> String
show :: Param -> String
$cshowList :: [Param] -> ShowS
showList :: [Param] -> ShowS
Show, Param -> Param -> Bool
(Param -> Param -> Bool) -> (Param -> Param -> Bool) -> Eq Param
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Param -> Param -> Bool
== :: Param -> Param -> Bool
$c/= :: Param -> Param -> Bool
/= :: Param -> Param -> Bool
Eq, Eq Param
Eq Param =>
(Param -> Param -> Ordering)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Bool)
-> (Param -> Param -> Param)
-> (Param -> Param -> Param)
-> Ord Param
Param -> Param -> Bool
Param -> Param -> Ordering
Param -> Param -> Param
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Param -> Param -> Ordering
compare :: Param -> Param -> Ordering
$c< :: Param -> Param -> Bool
< :: Param -> Param -> Bool
$c<= :: Param -> Param -> Bool
<= :: Param -> Param -> Bool
$c> :: Param -> Param -> Bool
> :: Param -> Param -> Bool
$c>= :: Param -> Param -> Bool
>= :: Param -> Param -> Bool
$cmax :: Param -> Param -> Param
max :: Param -> Param -> Param
$cmin :: Param -> Param -> Param
min :: Param -> Param -> Param
Ord, String -> Param
(String -> Param) -> IsString Param
forall a. (String -> a) -> IsString a
$cfromString :: String -> Param
fromString :: String -> Param
IsString)


-- | Encode arbitrarily complex data into url form encoded data
data ParamValue = ParamValue {ParamValue -> Text
value :: Text}
  deriving (ParamValue -> ParamValue -> Bool
(ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> Bool) -> Eq ParamValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamValue -> ParamValue -> Bool
== :: ParamValue -> ParamValue -> Bool
$c/= :: ParamValue -> ParamValue -> Bool
/= :: ParamValue -> ParamValue -> Bool
Eq, Int -> ParamValue -> ShowS
[ParamValue] -> ShowS
ParamValue -> String
(Int -> ParamValue -> ShowS)
-> (ParamValue -> String)
-> ([ParamValue] -> ShowS)
-> Show ParamValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamValue -> ShowS
showsPrec :: Int -> ParamValue -> ShowS
$cshow :: ParamValue -> String
show :: ParamValue -> String
$cshowList :: [ParamValue] -> ShowS
showList :: [ParamValue] -> ShowS
Show)


instance IsString ParamValue where
  fromString :: String -> ParamValue
fromString String
s = Text -> ParamValue
ParamValue (String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
s)


{- | 'session's, 'form's, and 'query's all encode data as query strings. ToParam and FromParam control how a datatype is encoded to a parameter.
 -
This is equivalent to Web.HttpApiData, which is missing some instances and has some strange defaults

@
data AppColor
  = White
  | Red
  | Green
  deriving (Show, Generic, 'ToParam', 'FromParam')
@
-}
class ToParam a where
  toParam :: a -> ParamValue
  default toParam :: (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue
  toParam = a -> ParamValue
forall a. (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue
genericToParam


instance ToParam Int where
  toParam :: Int -> ParamValue
toParam = Int -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Integer where
  toParam :: Integer -> ParamValue
toParam = Integer -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Text where
  toParam :: Text -> ParamValue
toParam = Text -> ParamValue
forall a. ToHttpApiData a => a -> ParamValue
toQueryParam
instance {-# OVERLAPS #-} ToParam String where
  toParam :: String -> ParamValue
toParam = String -> ParamValue
forall a. ToHttpApiData a => a -> ParamValue
toQueryParam
instance ToParam Float where
  toParam :: Float -> ParamValue
toParam = Float -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Double where
  toParam :: Double -> ParamValue
toParam = Double -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Word where
  toParam :: Word -> ParamValue
toParam = Word -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Word8 where
  toParam :: Word8 -> ParamValue
toParam = Word8 -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Word16 where
  toParam :: Word16 -> ParamValue
toParam = Word16 -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Word32 where
  toParam :: Word32 -> ParamValue
toParam = Word32 -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Word64 where
  toParam :: Word64 -> ParamValue
toParam = Word64 -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Bool where
  toParam :: Bool -> ParamValue
toParam = Bool -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam
instance ToParam Char where
  toParam :: Char -> ParamValue
toParam = Char -> ParamValue
forall a. ToHttpApiData a => a -> ParamValue
toQueryParam
instance ToParam UTCTime where
  toParam :: UTCTime -> ParamValue
toParam = UTCTime -> ParamValue
forall a. ToHttpApiData a => a -> ParamValue
toQueryParam
instance ToParam URI where
  toParam :: URI -> ParamValue
toParam = Text -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam (Text -> ParamValue) -> (URI -> Text) -> URI -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. URI -> Text
uriToText
instance ToParam Value where
  toParam :: Value -> ParamValue
toParam = Value -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam


{- | Decode data from a 'query', 'session', or 'form' parameter value

@
data AppColor
  = White
  | Red
  | Green
  deriving (Show, Generic, 'ToParam', 'FromParam')
@
-}
class FromParam a where
  parseParam :: ParamValue -> Either String a
  default parseParam :: (Generic a, GFromJSON Zero (Rep a)) => ParamValue -> Either String a
  parseParam = ParamValue -> Either String a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
ParamValue -> Either String a
genericParseParam


  decodeFormValue :: Maybe Text -> Either String a
  decodeFormValue Maybe Text
mval = do
    case Maybe Text
mval of
      Maybe Text
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left String
"missing form field value"
      Just Text
t -> do
        ParamValue -> Either String a
forall a. FromParam a => ParamValue -> Either String a
parseParam (ParamValue -> Either String a) -> ParamValue -> Either String a
forall a b. (a -> b) -> a -> b
$ Text -> ParamValue
ParamValue Text
t


-- decodeParamValue :: Text -> Either String a
-- decodeParamValue = parseParam . decodeParam

-- Permissive instances. Some of these come directly from forms!
instance FromParam Int where
  parseParam :: ParamValue -> Either String Int
parseParam ParamValue
"" = Int -> Either String Int
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0
  parseParam ParamValue
p = ParamValue -> Either String Int
forall a. FromJSON a => ParamValue -> Either String a
jsonParse ParamValue
p
instance FromParam Integer where
  parseParam :: ParamValue -> Either String Integer
parseParam ParamValue
"" = Integer -> Either String Integer
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
  parseParam ParamValue
p = ParamValue -> Either String Integer
forall a. FromJSON a => ParamValue -> Either String a
jsonParse ParamValue
p
instance FromParam Float where
  parseParam :: ParamValue -> Either String Float
parseParam ParamValue
"" = Float -> Either String Float
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Float
0
  parseParam ParamValue
p = ParamValue -> Either String Float
forall a. FromJSON a => ParamValue -> Either String a
jsonParse ParamValue
p
instance FromParam Double where
  parseParam :: ParamValue -> Either String Double
parseParam ParamValue
"" = Double -> Either String Double
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
0
  parseParam ParamValue
p = ParamValue -> Either String Double
forall a. FromJSON a => ParamValue -> Either String a
jsonParse ParamValue
p
instance FromParam Text where
  parseParam :: ParamValue -> Either String Text
parseParam = ParamValue -> Either String Text
forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam


-- -- we don't need to desanitize the text
-- parseFormField [inp] = do
--   parseParam $ ParamValue inp (String inp)

instance {-# OVERLAPS #-} FromParam String where
  parseParam :: ParamValue -> Either String String
parseParam ParamValue
p = Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> String) -> Either String Text -> Either String String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam @Text ParamValue
p


-- parseFormField sel f = do
--   inp :: Text <- first cs $ FE.parseUnique @Text (cs sel) f
--   parseParam $ ParamValue inp (String inp)
instance FromParam Word where
  parseParam :: ParamValue -> Either String Word
parseParam = ParamValue -> Either String Word
forall a. FromJSON a => ParamValue -> Either String a
jsonParse
instance FromParam Word8 where
  parseParam :: ParamValue -> Either String Word8
parseParam = ParamValue -> Either String Word8
forall a. FromJSON a => ParamValue -> Either String a
jsonParse
instance FromParam Word16 where
  parseParam :: ParamValue -> Either String Word16
parseParam = ParamValue -> Either String Word16
forall a. FromJSON a => ParamValue -> Either String a
jsonParse
instance FromParam Word32 where
  parseParam :: ParamValue -> Either String Word32
parseParam = ParamValue -> Either String Word32
forall a. FromJSON a => ParamValue -> Either String a
jsonParse
instance FromParam Word64 where
  parseParam :: ParamValue -> Either String Word64
parseParam = ParamValue -> Either String Word64
forall a. FromJSON a => ParamValue -> Either String a
jsonParse
instance FromParam Bool where
  parseParam :: ParamValue -> Either String Bool
parseParam (ParamValue Text
t) =
    case Text
t of
      Text
"on" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Text
"off" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Text
"" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Text
"false" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
      Text
"true" -> Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
      Text
other -> String -> Either String Bool
forall a b. a -> Either a b
Left (String -> Either String Bool) -> String -> Either String Bool
forall a b. (a -> b) -> a -> b
$ String
"Could not parse bool param: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
other


  decodeFormValue :: Maybe Text -> Either String Bool
decodeFormValue Maybe Text
Nothing = Bool -> Either String Bool
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
  decodeFormValue (Just Text
t) =
    ParamValue -> Either String Bool
forall a. FromParam a => ParamValue -> Either String a
parseParam (ParamValue -> Either String Bool)
-> ParamValue -> Either String Bool
forall a b. (a -> b) -> a -> b
$ Text -> ParamValue
ParamValue Text
t


instance FromParam Char where
  parseParam :: ParamValue -> Either String Char
parseParam = ParamValue -> Either String Char
forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam
instance FromParam UTCTime where
  parseParam :: ParamValue -> Either String UTCTime
parseParam = ParamValue -> Either String UTCTime
forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam
instance FromParam Value where
  parseParam :: ParamValue -> Either String Value
parseParam = ParamValue -> Either String Value
forall a. FromJSON a => ParamValue -> Either String a
jsonParse


instance FromParam URI where
  parseParam :: ParamValue -> Either String URI
parseParam (ParamValue Text
t) = do
    case String -> Maybe URI
parseURIReference (Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
t) of
      Maybe URI
Nothing -> String -> Either String URI
forall a b. a -> Either a b
Left (String -> Either String URI) -> String -> Either String URI
forall a b. (a -> b) -> a -> b
$ String
"Invalid URI: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
t
      Just URI
u -> URI -> Either String URI
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure URI
u


instance {-# OVERLAPPABLE #-} (ToParam a) => ToParam [a] where
  toParam :: [a] -> ParamValue
toParam [a]
as =
    -- JSON encode the individual params
    let [ParamValue]
ps :: [ParamValue] = (a -> ParamValue) -> [a] -> [ParamValue]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam [a]
as
     in Value -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam (Value -> ParamValue) -> Value -> ParamValue
forall a b. (a -> b) -> a -> b
$ Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ [Item Array] -> Array
forall l. IsList l => [Item l] -> l
fromList ([Item Array] -> Array) -> [Item Array] -> Array
forall a b. (a -> b) -> a -> b
$ (ParamValue -> Value) -> [ParamValue] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Value
String (Text -> Value) -> (ParamValue -> Text) -> ParamValue -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (.value)) [ParamValue]
ps
instance {-# OVERLAPPABLE #-} (FromParam a) => FromParam [a] where
  parseParam :: ParamValue -> Either String [a]
parseParam ParamValue
p = do
    [Text]
ts <- forall a. FromJSON a => ParamValue -> Either String a
jsonParse @[Text] ParamValue
p
    (Text -> Either String a) -> [Text] -> Either String [a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ParamValue -> Either String a
forall a. FromParam a => ParamValue -> Either String a
parseParam (ParamValue -> Either String a)
-> (Text -> ParamValue) -> Text -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParamValue
ParamValue) [Text]
ts


instance (ToParam a) => ToParam (Maybe a) where
  toParam :: Maybe a -> ParamValue
toParam Maybe a
Nothing = Text -> ParamValue
ParamValue Text
"~"
  toParam (Just a
a) = a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a
instance {-# OVERLAPPABLE #-} (FromParam a) => FromParam (Maybe a) where
  parseParam :: ParamValue -> Either String (Maybe a)
parseParam (ParamValue Text
"") = Maybe a -> Either String (Maybe a)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseParam (ParamValue Text
"~") = Maybe a -> Either String (Maybe a)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  parseParam ParamValue
t = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromParam a => ParamValue -> Either String a
parseParam @a ParamValue
t


  decodeFormValue :: Maybe Text -> Either String (Maybe a)
decodeFormValue Maybe Text
Nothing = Maybe a -> Either String (Maybe a)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
  decodeFormValue (Just Text
t) = do
    forall a. FromParam a => ParamValue -> Either String a
parseParam @(Maybe a) (Text -> ParamValue
ParamValue Text
t)


instance {-# OVERLAPS #-} FromParam (Maybe Text) where
  parseParam :: ParamValue -> Either String (Maybe Text)
parseParam (ParamValue Text
"~") = Maybe Text -> Either String (Maybe Text)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  -- keep empty strings, the default instance discards them
  parseParam (ParamValue Text
"") = Maybe Text -> Either String (Maybe Text)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"")
  parseParam ParamValue
t = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Either String Text -> Either String (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromParam a => ParamValue -> Either String a
parseParam @Text ParamValue
t


  decodeFormValue :: Maybe Text -> Either String (Maybe Text)
decodeFormValue Maybe Text
Nothing = Maybe Text -> Either String (Maybe Text)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  decodeFormValue (Just Text
t) = do
    forall a. FromParam a => ParamValue -> Either String a
parseParam @(Maybe Text) (Text -> ParamValue
ParamValue Text
t)


instance (ToParam a, ToParam b) => ToParam (Either a b) where
  toParam :: Either a b -> ParamValue
toParam (Left a
a) = a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a
  toParam (Right b
b) = b -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam b
b
instance (FromParam a, FromParam b) => FromParam (Either a b) where
  parseParam :: ParamValue -> Either String (Either a b)
parseParam ParamValue
val =
    case forall a. FromParam a => ParamValue -> Either String a
parseParam @a ParamValue
val of
      Right a
a -> Either a b -> Either String (Either a b)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> Either String (Either a b))
-> Either a b -> Either String (Either a b)
forall a b. (a -> b) -> a -> b
$ a -> Either a b
forall a b. a -> Either a b
Left a
a
      Left String
_ -> do
        case forall a. FromParam a => ParamValue -> Either String a
parseParam @b ParamValue
val of
          Left String
_ -> String -> Either String (Either a b)
forall a b. a -> Either a b
Left (String -> Either String (Either a b))
-> String -> Either String (Either a b)
forall a b. (a -> b) -> a -> b
$ String
"Could not parse Either param: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ParamValue -> String
forall a. Show a => a -> String
show ParamValue
val
          Right b
b -> Either a b -> Either String (Either a b)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> Either String (Either a b))
-> Either a b -> Either String (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
b


parseQueryParam :: (FromHttpApiData a) => ParamValue -> Either String a
parseQueryParam :: forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam (ParamValue Text
t) =
  (Text -> String) -> Either Text a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (Either Text a -> Either String a)
-> Either Text a -> Either String a
forall a b. (a -> b) -> a -> b
$ Text -> Either Text a
forall a. FromHttpApiData a => Text -> Either Text a
HttpApiData.parseQueryParam Text
t


toQueryParam :: (ToHttpApiData a) => a -> ParamValue
toQueryParam :: forall a. ToHttpApiData a => a -> ParamValue
toQueryParam a
a =
  Text -> ParamValue
ParamValue (Text -> ParamValue) -> Text -> ParamValue
forall a b. (a -> b) -> a -> b
$ a -> Text
forall a. ToHttpApiData a => a -> Text
HttpApiData.toQueryParam a
a


-- | Encode a Show as a query param
showParam :: (Show a) => a -> ParamValue
showParam :: forall a. Show a => a -> ParamValue
showParam a
a = String -> ParamValue
forall a. ToHttpApiData a => a -> ParamValue
toQueryParam (String -> ParamValue) -> String -> ParamValue
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a


-- | Decode a Read as a query param
readParam :: (Read a) => ParamValue -> Either String a
readParam :: forall a. Read a => ParamValue -> Either String a
readParam ParamValue
p = do
  String
str <- ParamValue -> Either String String
forall a. FromHttpApiData a => ParamValue -> Either String a
parseQueryParam ParamValue
p
  case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str of
    Maybe a
Nothing -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ShowS
forall a b. ConvertibleStrings a b => a -> b
cs ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"Could not read query param: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str
    Just a
a -> a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


genericToParam :: (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue
genericToParam :: forall a. (Generic a, GToJSON Zero (Rep a)) => a -> ParamValue
genericToParam a
a =
  case Options -> a -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
jsonOptions a
a of
    String Text
t -> Text -> ParamValue
ParamValue Text
t
    Value
other -> Value -> ParamValue
forall a. ToJSON a => a -> ParamValue
jsonParam Value
other


genericParseParam :: (Generic a, GFromJSON Zero (Rep a)) => ParamValue -> Either String a
genericParseParam :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
ParamValue -> Either String a
genericParseParam (ParamValue Text
t) = do
  Value
val <- Either String Value
-> (Value -> Either String Value)
-> Maybe Value
-> Either String Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
t) Value -> Either String Value
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> Either String Value)
-> Maybe Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decode (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
t)
  (Value -> Parser a) -> Value -> Either String a
forall a b. (a -> Parser b) -> a -> Either String b
A.parseEither (Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
jsonOptions) Value
val


-- Encoding ------------------------------------------------------------

jsonOptions :: A.Options
jsonOptions :: Options
jsonOptions = Options
defaultOptions{sumEncoding = TwoElemArray}


jsonParam :: (ToJSON a) => a -> ParamValue
jsonParam :: forall a. ToJSON a => a -> ParamValue
jsonParam a
a = Text -> ParamValue
ParamValue (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode a
a)


jsonParse :: (FromJSON a) => ParamValue -> Either String a
jsonParse :: forall a. FromJSON a => ParamValue -> Either String a
jsonParse (ParamValue Text
t) = do
  ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
t)