{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE UndecidableInstances #-}

module Web.Hyperbole.Data.QueryData where

import Data.Bifunctor (bimap)
import Data.ByteString (ByteString)
import Data.Default (Default (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe)
import Data.String (IsString)
import Data.String.Conversions (cs)
import Data.Text (Text, pack)
import Data.Time (UTCTime)
import Data.Word
import GHC.Generics
import Network.HTTP.Types (Query, renderQuery)
import Network.HTTP.Types qualified as HTTP
import Text.Read (readMaybe)
import Web.HttpApiData (parseQueryParam, toQueryParam)
import Prelude hiding (lookup)


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)


newtype ParamValue = ParamValue {ParamValue -> Text
text :: Text}
  deriving newtype (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, 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, Eq ParamValue
Eq ParamValue =>
(ParamValue -> ParamValue -> Ordering)
-> (ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> Bool)
-> (ParamValue -> ParamValue -> ParamValue)
-> (ParamValue -> ParamValue -> ParamValue)
-> Ord ParamValue
ParamValue -> ParamValue -> Bool
ParamValue -> ParamValue -> Ordering
ParamValue -> ParamValue -> ParamValue
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 :: ParamValue -> ParamValue -> Ordering
compare :: ParamValue -> ParamValue -> Ordering
$c< :: ParamValue -> ParamValue -> Bool
< :: ParamValue -> ParamValue -> Bool
$c<= :: ParamValue -> ParamValue -> Bool
<= :: ParamValue -> ParamValue -> Bool
$c> :: ParamValue -> ParamValue -> Bool
> :: ParamValue -> ParamValue -> Bool
$c>= :: ParamValue -> ParamValue -> Bool
>= :: ParamValue -> ParamValue -> Bool
$cmax :: ParamValue -> ParamValue -> ParamValue
max :: ParamValue -> ParamValue -> ParamValue
$cmin :: ParamValue -> ParamValue -> ParamValue
min :: ParamValue -> ParamValue -> ParamValue
Ord, String -> ParamValue
(String -> ParamValue) -> IsString ParamValue
forall a. (String -> a) -> IsString a
$cfromString :: String -> ParamValue
fromString :: String -> ParamValue
IsString)


-- | Key-value store for query params and sessions
newtype QueryData = QueryData (Map Param ParamValue)
  deriving (Int -> QueryData -> ShowS
[QueryData] -> ShowS
QueryData -> String
(Int -> QueryData -> ShowS)
-> (QueryData -> String)
-> ([QueryData] -> ShowS)
-> Show QueryData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryData -> ShowS
showsPrec :: Int -> QueryData -> ShowS
$cshow :: QueryData -> String
show :: QueryData -> String
$cshowList :: [QueryData] -> ShowS
showList :: [QueryData] -> ShowS
Show)
  deriving newtype (Semigroup QueryData
QueryData
Semigroup QueryData =>
QueryData
-> (QueryData -> QueryData -> QueryData)
-> ([QueryData] -> QueryData)
-> Monoid QueryData
[QueryData] -> QueryData
QueryData -> QueryData -> QueryData
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: QueryData
mempty :: QueryData
$cmappend :: QueryData -> QueryData -> QueryData
mappend :: QueryData -> QueryData -> QueryData
$cmconcat :: [QueryData] -> QueryData
mconcat :: [QueryData] -> QueryData
Monoid, NonEmpty QueryData -> QueryData
QueryData -> QueryData -> QueryData
(QueryData -> QueryData -> QueryData)
-> (NonEmpty QueryData -> QueryData)
-> (forall b. Integral b => b -> QueryData -> QueryData)
-> Semigroup QueryData
forall b. Integral b => b -> QueryData -> QueryData
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: QueryData -> QueryData -> QueryData
<> :: QueryData -> QueryData -> QueryData
$csconcat :: NonEmpty QueryData -> QueryData
sconcat :: NonEmpty QueryData -> QueryData
$cstimes :: forall b. Integral b => b -> QueryData -> QueryData
stimes :: forall b. Integral b => b -> QueryData -> QueryData
Semigroup)


singleton :: (ToParam a) => Param -> a -> QueryData
singleton :: forall a. ToParam a => Param -> a -> QueryData
singleton Param
key a
a = Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> Map Param ParamValue -> QueryData
forall a b. (a -> b) -> a -> b
$ Param -> ParamValue -> Map Param ParamValue
forall k a. k -> a -> Map k a
M.singleton Param
key (a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a)


insert :: (ToParam a) => Param -> a -> QueryData -> QueryData
insert :: forall a. ToParam a => Param -> a -> QueryData -> QueryData
insert Param
p a
a (QueryData Map Param ParamValue
m) =
  let val :: ParamValue
val = a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a
   in Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> Map Param ParamValue -> QueryData
forall a b. (a -> b) -> a -> b
$ Param -> ParamValue -> Map Param ParamValue -> Map Param ParamValue
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Param
p ParamValue
val Map Param ParamValue
m


insertAll :: (ToQuery a) => a -> QueryData -> QueryData
insertAll :: forall a. ToQuery a => a -> QueryData -> QueryData
insertAll a
a (QueryData Map Param ParamValue
m) =
  let QueryData Map Param ParamValue
kvs = a -> QueryData
forall a. ToQuery a => a -> QueryData
toQuery a
a
   in Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> Map Param ParamValue -> QueryData
forall a b. (a -> b) -> a -> b
$ Map Param ParamValue
-> Map Param ParamValue -> Map Param ParamValue
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map Param ParamValue
kvs Map Param ParamValue
m


delete :: Param -> QueryData -> QueryData
delete :: Param -> QueryData -> QueryData
delete Param
p (QueryData Map Param ParamValue
m) =
  Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> Map Param ParamValue -> QueryData
forall a b. (a -> b) -> a -> b
$ Param -> Map Param ParamValue -> Map Param ParamValue
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Param
p Map Param ParamValue
m


lookup :: (FromParam a) => Param -> QueryData -> Maybe a
lookup :: forall a. FromParam a => Param -> QueryData -> Maybe a
lookup Param
k (QueryData Map Param ParamValue
m) = do
  ParamValue
t <- Param -> Map Param ParamValue -> Maybe ParamValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Param
k Map Param ParamValue
m
  (Text -> Maybe a) -> (a -> Maybe a) -> Either Text a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> Text -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text a -> Maybe a) -> Either Text a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam ParamValue
t


require :: (FromParam a) => Param -> QueryData -> Either Text a
require :: forall a. FromParam a => Param -> QueryData -> Either Text a
require Param
p (QueryData Map Param ParamValue
m) = do
  case Param -> Map Param ParamValue -> Maybe ParamValue
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Param
p Map Param ParamValue
m of
    Maybe ParamValue
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ Text
"Missing Key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Param
p.text
    Just ParamValue
val -> ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam ParamValue
val


filterKey :: (Param -> Bool) -> QueryData -> QueryData
filterKey :: (Param -> Bool) -> QueryData -> QueryData
filterKey Param -> Bool
p (QueryData Map Param ParamValue
m) =
  Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> Map Param ParamValue -> QueryData
forall a b. (a -> b) -> a -> b
$ (Param -> ParamValue -> Bool)
-> Map Param ParamValue -> Map Param ParamValue
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey (\Param
k ParamValue
_ -> Param -> Bool
p Param
k) Map Param ParamValue
m


member :: Param -> QueryData -> Bool
member :: Param -> QueryData -> Bool
member Param
k (QueryData Map Param ParamValue
qd) = Param -> Map Param ParamValue -> Bool
forall k a. Ord k => k -> Map k a -> Bool
M.member Param
k Map Param ParamValue
qd


elems :: QueryData -> [ParamValue]
elems :: QueryData -> [ParamValue]
elems (QueryData Map Param ParamValue
m) = Map Param ParamValue -> [ParamValue]
forall k a. Map k a -> [a]
M.elems Map Param ParamValue
m


render :: QueryData -> ByteString
render :: QueryData -> ByteString
render (QueryData Map Param ParamValue
m) =
  -- urlEncode True
  Bool -> Query -> ByteString
renderQuery Bool
False ([(Text, Text)] -> Query
forall a. QueryLike a => a -> Query
HTTP.toQuery ([(Text, Text)] -> Query) -> [(Text, Text)] -> Query
forall a b. (a -> b) -> a -> b
$ ((Param, ParamValue) -> (Text, Text))
-> [(Param, ParamValue)] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Param, ParamValue) -> (Text, Text)
queryItem ([(Param, ParamValue)] -> [(Text, Text)])
-> [(Param, ParamValue)] -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ Map Param ParamValue -> [(Param, ParamValue)]
forall k a. Map k a -> [(k, a)]
M.toList Map Param ParamValue
m)
 where
  queryItem :: (Param, ParamValue) -> (Text, Text)
queryItem (Param Text
k, ParamValue Text
val) = (Text
k, Text
val)


parse :: ByteString -> QueryData
parse :: ByteString -> QueryData
parse =
  -- urlDecode True
  Query -> QueryData
queryData (Query -> QueryData)
-> (ByteString -> Query) -> ByteString -> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
HTTP.parseQuery


queryData :: Query -> QueryData
queryData :: Query -> QueryData
queryData =
  Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> (Query -> Map Param ParamValue) -> Query -> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Param, ParamValue)] -> Map Param ParamValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Param, ParamValue)] -> Map Param ParamValue)
-> (Query -> [(Param, ParamValue)])
-> Query
-> Map Param ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QueryItem -> (Param, ParamValue))
-> Query -> [(Param, ParamValue)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> Param)
-> (Maybe ByteString -> ParamValue)
-> QueryItem
-> (Param, ParamValue)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (Text -> Param
Param (Text -> Param) -> (ByteString -> Text) -> ByteString -> Param
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs) Maybe ByteString -> ParamValue
forall {a}. ConvertibleStrings a Text => Maybe a -> ParamValue
value)
 where
  -- empty / missing values are encoded as empty strings
  value :: Maybe a -> ParamValue
value Maybe a
Nothing = ParamValue
""
  value (Just a
v) = Text -> ParamValue
ParamValue (a -> Text
forall a b. ConvertibleStrings a b => a -> b
cs a
v)


fromList :: [(Param, ParamValue)] -> QueryData
fromList :: [(Param, ParamValue)] -> QueryData
fromList = Map Param ParamValue -> QueryData
QueryData (Map Param ParamValue -> QueryData)
-> ([(Param, ParamValue)] -> Map Param ParamValue)
-> [(Param, ParamValue)]
-> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Param, ParamValue)] -> Map Param ParamValue
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList


toList :: QueryData -> [(Param, ParamValue)]
toList :: QueryData -> [(Param, ParamValue)]
toList (QueryData Map Param ParamValue
m) = Map Param ParamValue -> [(Param, ParamValue)]
forall k a. Map k a -> [(k, a)]
M.toList Map Param ParamValue
m


{- | Decode a type from a 'QueryData'. Missing fields are set to 'defaultParam'

@
data Filters = Filters
  { active :: Bool
  , term :: Text
  }
  deriving (Generic, 'FromQuery', 'ToQuery')
@

>>> parseQuery $ parse "active=true&search=asdf"
Right (Filters True "asdf")

>>> parseQuery $ parse "search=asdf"
Right (Filters False "asdf")
-}
class FromQuery a where
  parseQuery :: QueryData -> Either Text a
  default parseQuery :: (Generic a, GFromQuery (Rep a)) => QueryData -> Either Text a
  parseQuery QueryData
q = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a) -> Either Text (Rep a Any) -> Either Text a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryData -> Either Text (Rep a Any)
forall p. QueryData -> Either Text (Rep a p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either Text (f p)
gParseQuery QueryData
q


instance FromQuery QueryData where
  parseQuery :: QueryData -> Either Text QueryData
parseQuery = QueryData -> Either Text QueryData
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


{- | A page can store state in the browser 'query' string. ToQuery and 'FromQuery' control how a datatype is encoded to a full query string

@
data Filters = Filters
  { active :: Bool
  , term :: Text
  }
  deriving (Generic, 'FromQuery', 'ToQuery')
@

>>> render $ toQuery $ Filter True "asdf"
"active=true&search=asdf"

If the value of a field is the same as 'DefaultParam', it will be omitted from the query string

>>> render $ toQuery $ Filter True ""
"active=true"

>>> render $ toQuery $ Filter False ""
""
-}
class ToQuery a where
  toQuery :: a -> QueryData
  default toQuery :: (Generic a, GToQuery (Rep a)) => a -> QueryData
  toQuery = Rep a Any -> QueryData
forall p. Rep a p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery (Rep a Any -> QueryData) -> (a -> Rep a Any) -> a -> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from


instance ToQuery QueryData where
  toQuery :: QueryData -> QueryData
toQuery = QueryData -> QueryData
forall a. a -> a
id


instance ToQuery Query where
  toQuery :: Query -> QueryData
toQuery = Query -> QueryData
queryData


{- | '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. By default it simply url-encodes the show instance.

@
data Todo = Todo
  { id :: TodoId
  , task :: Text
  , completed :: Bool
  }
  deriving (Show, Read, 'ToParam', 'FromParam')
@

@
data Tags = Tags [Text]

instance 'ToParam' Tags where
  toParam (Tags ts) = ParamValue $ Text.intercalate \",\" ts
@
-}
class ToParam a where
  toParam :: a -> ParamValue
  default toParam :: (Show a) => a -> ParamValue
  toParam = a -> ParamValue
forall a. Show a => a -> ParamValue
showQueryParam


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

@
data Todo = Todo
  { id :: TodoId
  , task :: Text
  , completed :: Bool
  }
  deriving (Show, Read, 'ToParam', 'FromParam')
@

@
data Tags = Tags [Text]

instance 'FromParam' Tags where
  parseParam (ParamValue t) =
    pure $ Tags $ Text.splitOn \",\" t
@
-}
class FromParam a where
  parseParam :: ParamValue -> Either Text a
  default parseParam :: (Read a) => ParamValue -> Either Text a
  parseParam = ParamValue -> Either Text a
forall a. Read a => ParamValue -> Either Text a
readQueryParam


instance ToParam Int where
  toParam :: Int -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Int -> Text) -> Int -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Int where
  parseParam :: ParamValue -> Either Text Int
parseParam (ParamValue Text
t) = Text -> Either Text Int
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Integer where
  toParam :: Integer -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Integer -> Text) -> Integer -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Integer where
  parseParam :: ParamValue -> Either Text Integer
parseParam (ParamValue Text
t) = Text -> Either Text Integer
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Float where
  toParam :: Float -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Float -> Text) -> Float -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Float where
  parseParam :: ParamValue -> Either Text Float
parseParam (ParamValue Text
t) = Text -> Either Text Float
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Double where
  toParam :: Double -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Double -> Text) -> Double -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Double where
  parseParam :: ParamValue -> Either Text Double
parseParam (ParamValue Text
t) = Text -> Either Text Double
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Word where
  toParam :: Word -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Word -> Text) -> Word -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Word where
  parseParam :: ParamValue -> Either Text Word
parseParam (ParamValue Text
t) = Text -> Either Text Word
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Word8 where
  toParam :: Word8 -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Word8 -> Text) -> Word8 -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Word8 where
  parseParam :: ParamValue -> Either Text Word8
parseParam (ParamValue Text
t) = Text -> Either Text Word8
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Word16 where
  toParam :: Word16 -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Word16 -> Text) -> Word16 -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Word16 where
  parseParam :: ParamValue -> Either Text Word16
parseParam (ParamValue Text
t) = Text -> Either Text Word16
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Word32 where
  toParam :: Word32 -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Word32 -> Text) -> Word32 -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Word32 where
  parseParam :: ParamValue -> Either Text Word32
parseParam (ParamValue Text
t) = Text -> Either Text Word32
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Word64 where
  toParam :: Word64 -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Word64 -> Text) -> Word64 -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Word64 where
  parseParam :: ParamValue -> Either Text Word64
parseParam (ParamValue Text
t) = Text -> Either Text Word64
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Bool where
  toParam :: Bool -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Bool -> Text) -> Bool -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Bool where
  parseParam :: ParamValue -> Either Text Bool
parseParam (ParamValue Text
t) = Text -> Either Text Bool
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Text where
  toParam :: Text -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Text -> Text) -> Text -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Text where
  parseParam :: ParamValue -> Either Text Text
parseParam (ParamValue Text
t) = Text -> Either Text Text
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam Char where
  toParam :: Char -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (Char -> Text) -> Char -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam Char where
  parseParam :: ParamValue -> Either Text Char
parseParam (ParamValue Text
t) = Text -> Either Text Char
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance ToParam UTCTime where
  toParam :: UTCTime -> ParamValue
toParam = Text -> ParamValue
ParamValue (Text -> ParamValue) -> (UTCTime -> Text) -> UTCTime -> ParamValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam
instance FromParam UTCTime where
  parseParam :: ParamValue -> Either Text UTCTime
parseParam (ParamValue Text
t) = Text -> Either Text UTCTime
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t


instance (Show a) => ToParam [a] where
  toParam :: [a] -> ParamValue
toParam = [a] -> ParamValue
forall a. Show a => a -> ParamValue
showQueryParam
instance (Read a) => FromParam [a] where
  parseParam :: ParamValue -> Either Text [a]
parseParam = ParamValue -> Either Text [a]
forall a. Read a => ParamValue -> Either Text a
readQueryParam


instance (Show k, Show v) => ToParam (Map k v) where
  toParam :: Map k v -> ParamValue
toParam = Map k v -> ParamValue
forall a. Show a => a -> ParamValue
showQueryParam
instance (Read k, Read v, Ord k) => FromParam (Map k v) where
  parseParam :: ParamValue -> Either Text (Map k v)
parseParam = ParamValue -> Either Text (Map k v)
forall a. Read a => ParamValue -> Either Text a
readQueryParam


instance (ToParam a) => ToParam (Maybe a) where
  toParam :: Maybe a -> ParamValue
toParam Maybe a
Nothing = ParamValue
""
  toParam (Just a
a) = a -> ParamValue
forall a. ToParam a => a -> ParamValue
toParam a
a
instance (FromParam a) => FromParam (Maybe a) where
  parseParam :: ParamValue -> Either Text (Maybe a)
parseParam ParamValue
"" = Maybe a -> Either Text (Maybe a)
forall a. a -> Either Text 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 Text a -> Either Text (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromParam a => ParamValue -> Either Text a
parseParam @a ParamValue
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 Text (Either a b)
parseParam ParamValue
val =
    case forall a. FromParam a => ParamValue -> Either Text a
parseParam @a ParamValue
val of
      Right a
a -> Either a b -> Either Text (Either a b)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> Either Text (Either a b))
-> Either a b -> Either Text (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 Text
_ -> do
        case forall a. FromParam a => ParamValue -> Either Text a
parseParam @b ParamValue
val of
          Left Text
_ -> Text -> Either Text (Either a b)
forall a b. a -> Either a b
Left (Text -> Either Text (Either a b))
-> Text -> Either Text (Either a b)
forall a b. (a -> b) -> a -> b
$ Text
"Could not parseParam Either: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ParamValue
val.text
          Right b
b -> Either a b -> Either Text (Either a b)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either a b -> Either Text (Either a b))
-> Either a b -> Either Text (Either a b)
forall a b. (a -> b) -> a -> b
$ b -> Either a b
forall a b. b -> Either a b
Right b
b


-- | Encode a Show as a query param
showQueryParam :: (Show a) => a -> ParamValue
showQueryParam :: forall a. Show a => a -> ParamValue
showQueryParam a
a = Text -> ParamValue
ParamValue (Text -> ParamValue) -> Text -> ParamValue
forall a b. (a -> b) -> a -> b
$ String -> Text
forall a. ToHttpApiData a => a -> Text
toQueryParam (String -> Text) -> String -> Text
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
readQueryParam :: (Read a) => ParamValue -> Either Text a
readQueryParam :: forall a. Read a => ParamValue -> Either Text a
readQueryParam (ParamValue Text
t) = do
  String
str <- Text -> Either Text String
forall a. FromHttpApiData a => Text -> Either Text a
parseQueryParam Text
t
  case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
str of
    Maybe a
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
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 Text a
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a


-- | Parse a Traversable (list) of params
parseParams :: (Traversable t, FromParam a) => t ParamValue -> Either Text (t a)
parseParams :: forall (t :: * -> *) a.
(Traversable t, FromParam a) =>
t ParamValue -> Either Text (t a)
parseParams = (ParamValue -> Either Text a) -> t ParamValue -> Either Text (t a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse ParamValue -> Either Text a
forall a. FromParam a => ParamValue -> Either Text a
parseParam


-- | Generic decoding of records from a Query
class GFromQuery f where
  gParseQuery :: QueryData -> Either Text (f p)


instance (GFromQuery f, GFromQuery g) => GFromQuery (f :*: g) where
  gParseQuery :: forall (p :: k). QueryData -> Either Text ((:*:) f g p)
gParseQuery QueryData
q = do
    f p
a <- QueryData -> Either Text (f p)
forall (p :: k). QueryData -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either Text (f p)
gParseQuery QueryData
q
    g p
b <- QueryData -> Either Text (g p)
forall (p :: k). QueryData -> Either Text (g p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either Text (f p)
gParseQuery QueryData
q
    (:*:) f g p -> Either Text ((:*:) f g p)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((:*:) f g p -> Either Text ((:*:) f g p))
-> (:*:) f g p -> Either Text ((:*:) f g p)
forall a b. (a -> b) -> a -> b
$ f p
a f p -> g p -> (:*:) f g p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: g p
b


instance (GFromQuery f) => GFromQuery (M1 D d f) where
  gParseQuery :: forall (p :: k). QueryData -> Either Text (M1 D d f p)
gParseQuery QueryData
q = f p -> M1 D d f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 D d f p)
-> Either Text (f p) -> Either Text (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryData -> Either Text (f p)
forall (p :: k). QueryData -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either Text (f p)
gParseQuery QueryData
q


instance (GFromQuery f) => GFromQuery (M1 C c f) where
  gParseQuery :: forall (p :: k). QueryData -> Either Text (M1 C c f p)
gParseQuery QueryData
q = f p -> M1 C c f p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (f p -> M1 C c f p)
-> Either Text (f p) -> Either Text (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryData -> Either Text (f p)
forall (p :: k). QueryData -> Either Text (f p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either Text (f p)
gParseQuery QueryData
q


instance (Selector s, FromParam a, DefaultParam a) => GFromQuery (M1 S s (K1 R a)) where
  gParseQuery :: forall (p :: k). QueryData -> Either Text (M1 S s (K1 R a) p)
gParseQuery QueryData
q = do
    let s :: String
s = M1 S s (K1 R (Any a)) Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 R (f a)) p
forall {k} {f :: * -> *} {p :: k}. M1 S s (K1 R (f a)) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R (f a)) p)
    let mval :: Maybe a
mval = Param -> QueryData -> Maybe a
forall a. FromParam a => Param -> QueryData -> Maybe a
lookup (Text -> Param
Param (Text -> Param) -> Text -> Param
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s) QueryData
q
    M1 S s (K1 R a) p -> Either Text (M1 S s (K1 R a) p)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M1 S s (K1 R a) p -> Either Text (M1 S s (K1 R a) p))
-> M1 S s (K1 R a) p -> Either Text (M1 S s (K1 R a) p)
forall a b. (a -> b) -> a -> b
$ K1 R a p -> M1 S s (K1 R a) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R a p -> M1 S s (K1 R a) p) -> K1 R a p -> M1 S s (K1 R a) p
forall a b. (a -> b) -> a -> b
$ a -> K1 R a p
forall k i c (p :: k). c -> K1 i c p
K1 (a -> K1 R a p) -> a -> K1 R a p
forall a b. (a -> b) -> a -> b
$ a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. DefaultParam a => a
defaultParam Maybe a
mval


-- | Generic encoding of records to a Query
class GToQuery f where
  gToQuery :: f p -> QueryData


instance (GToQuery f, GToQuery g) => GToQuery (f :*: g) where
  gToQuery :: forall (p :: k). (:*:) f g p -> QueryData
gToQuery (f p
f :*: g p
g) = f p -> QueryData
forall (p :: k). f p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery f p
f QueryData -> QueryData -> QueryData
forall a. Semigroup a => a -> a -> a
<> g p -> QueryData
forall (p :: k). g p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery g p
g


instance (GToQuery f) => GToQuery (M1 D d f) where
  gToQuery :: forall (p :: k). M1 D d f p -> QueryData
gToQuery (M1 f p
f) = f p -> QueryData
forall (p :: k). f p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery f p
f


instance (GToQuery f) => GToQuery (M1 C d f) where
  gToQuery :: forall (p :: k). M1 C d f p -> QueryData
gToQuery (M1 f p
f) = f p -> QueryData
forall (p :: k). f p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery f p
f


instance (Selector s, ToParam a, Eq a, DefaultParam a) => GToQuery (M1 S s (K1 R a)) where
  gToQuery :: forall (p :: k). M1 S s (K1 R a) p -> QueryData
gToQuery (M1 (K1 a
a))
    | a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. DefaultParam a => a
defaultParam = QueryData
forall a. Monoid a => a
mempty
    | Bool
otherwise =
        let sel :: Param
sel = Text -> Param
Param (Text -> Param) -> Text -> Param
forall a b. (a -> b) -> a -> b
$ String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ M1 S s (K1 R (Any a)) Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t s f a -> String
selName (M1 S s (K1 R (f a)) p
forall {k} {f :: * -> *} {p :: k}. M1 S s (K1 R (f a)) p
forall a. HasCallStack => a
undefined :: M1 S s (K1 R (f a)) p)
         in Param -> a -> QueryData
forall a. ToParam a => Param -> a -> QueryData
singleton Param
sel a
a


-- | Data.Default doesn't have a Text instance. This class does
class DefaultParam a where
  defaultParam :: a
  default defaultParam :: (Default a) => a
  defaultParam = a
forall a. Default a => a
def


instance {-# OVERLAPPABLE #-} (Default a) => DefaultParam a where
  defaultParam :: a
defaultParam = a
forall a. Default a => a
def


instance {-# OVERLAPS #-} DefaultParam Text where
  defaultParam :: Text
defaultParam = Text
""