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

module Web.Hyperbole.Data.QueryData where

import Control.Applicative ((<|>))
import Data.Aeson (FromJSON (..), Result (..), ToJSON (..), Value (..), fromJSON)
import Data.Aeson qualified as A
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.Text qualified as T
import GHC.Exts (IsList (..))
import GHC.Generics
import Network.HTTP.Types (Query, QueryItem, renderQuery)
import Network.HTTP.Types qualified as HTTP
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)


-- | Key-value store for query params and sessions
newtype QueryData = QueryData (Map Param Text)
  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)


instance IsList QueryData where
  type Item QueryData = (Param, Text)
  fromList :: [Item QueryData] -> QueryData
fromList = Map Param Text -> QueryData
QueryData (Map Param Text -> QueryData)
-> ([(Param, Text)] -> Map Param Text)
-> [(Param, Text)]
-> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Param, Text)] -> Map Param Text
[Item (Map Param Text)] -> Map Param Text
forall l. IsList l => [Item l] -> l
fromList
  toList :: QueryData -> [Item QueryData]
toList (QueryData Map Param Text
m) = Map Param Text -> [Item (Map Param Text)]
forall l. IsList l => l -> [Item l]
toList Map Param Text
m


parseParam :: (FromJSON a) => Value -> Either String a
parseParam :: forall a. FromJSON a => Value -> Either String a
parseParam Value
v =
  case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
    Success a
a -> a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Error String
e -> String -> Either String a
forall a b. a -> Either a b
Left String
e


-- the "default" encoding uses unquoted strings
encodeParam :: (ToJSON a) => a -> Text
encodeParam :: forall a. ToJSON a => a -> Text
encodeParam a
a = do
  case a -> Value
forall a. ToJSON a => a -> Value
A.toJSON a
a of
    String Text
s -> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
s
    Value
val -> ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode Value
val


-- | Decode a parameter from JSON. Uses unquoted strings when possible
decodeParam :: (FromJSON a) => Text -> Either String a
decodeParam :: forall a. FromJSON a => Text -> Either String a
decodeParam Text
inp = Either String a
-> (a -> Either String a) -> Maybe a -> Either String a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (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
$ String
"Could not decode Query Param: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
inp) a -> Either String a
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> Either String a) -> Maybe a -> Either String a
forall a b. (a -> b) -> a -> b
$ do
  ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
A.decode (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
inp) Maybe a -> Maybe a -> Maybe a
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> Maybe a
forall a. FromJSON a => ByteString -> Maybe a
A.decode (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
inp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\"")


singleton :: (ToJSON a) => Param -> a -> QueryData
singleton :: forall a. ToJSON a => Param -> a -> QueryData
singleton Param
key a
a = Map Param Text -> QueryData
QueryData (Map Param Text -> QueryData) -> Map Param Text -> QueryData
forall a b. (a -> b) -> a -> b
$ Param -> Text -> Map Param Text
forall k a. k -> a -> Map k a
M.singleton Param
key (a -> Text
forall a. ToJSON a => a -> Text
encodeParam a
a)


insert :: (ToJSON a) => Param -> a -> QueryData -> QueryData
insert :: forall a. ToJSON a => Param -> a -> QueryData -> QueryData
insert Param
p a
a (QueryData Map Param Text
m) =
  Map Param Text -> QueryData
QueryData (Map Param Text -> QueryData) -> Map Param Text -> QueryData
forall a b. (a -> b) -> a -> b
$ Param -> Text -> Map Param Text -> Map Param Text
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Param
p (a -> Text
forall a. ToJSON a => a -> Text
encodeParam a
a) Map Param Text
m


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


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


lookup :: (FromJSON a) => Param -> QueryData -> Maybe a
lookup :: forall a. FromJSON a => Param -> QueryData -> Maybe a
lookup Param
k (QueryData Map Param Text
m) = do
  t :: Text <- Param -> Map Param Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Param
k Map Param Text
m
  either (const Nothing) pure $ decodeParam t


require :: (FromJSON a) => Param -> QueryData -> Either String a
require :: forall a. FromJSON a => Param -> QueryData -> Either String a
require Param
p (QueryData Map Param Text
m) = do
  case Param -> Map Param Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Param
p Map Param Text
m of
    Maybe Text
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
$ String
"Missing Key: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Param
p.text
    Just Text
val -> Text -> Either String a
forall a. FromJSON a => Text -> Either String a
decodeParam Text
val


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


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


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


render :: QueryData -> Text
render :: QueryData -> Text
render QueryData
qd =
  HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"%20" Text
"+" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> Query -> ByteString
renderQuery Bool
False (Query -> Query
forall a. QueryLike a => a -> Query
HTTP.toQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ QueryData -> Query
fromQueryData QueryData
qd)


parse :: Text -> QueryData
parse :: Text -> QueryData
parse =
  -- it already knows how to handle + signs on parse
  Query -> QueryData
queryData (Query -> QueryData) -> (Text -> Query) -> Text -> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Query
HTTP.parseQuery (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs


queryData :: Query -> QueryData
queryData :: Query -> QueryData
queryData Query
q =
  [Item QueryData] -> QueryData
forall l. IsList l => [Item l] -> l
fromList ([Item QueryData] -> QueryData) -> [Item QueryData] -> QueryData
forall a b. (a -> b) -> a -> b
$ (QueryItem -> (Param, Text)) -> Query -> [(Param, Text)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryItem -> (Param, Text)
fromQueryItem Query
q
 where
  fromQueryItem :: QueryItem -> (Param, Text)
  fromQueryItem :: QueryItem -> (Param, Text)
fromQueryItem (ByteString
key, Maybe ByteString
mval) = do
    (Text -> Param
Param (ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
key), Maybe ByteString -> Text
fromParam Maybe ByteString
mval)

  -- do we include fields that don't have a value? Sure
  fromParam :: Maybe ByteString -> Text
  fromParam :: Maybe ByteString -> Text
fromParam Maybe ByteString
Nothing = Text
""
  fromParam (Just ByteString
t) = ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
t


-- Now we have our own thing!
-- 1. ALWAYS encode strings without quotes
-- 2. How do you distinguish between numbers and strings then?

-- problem: strings are always quoted
-- if we unquote them, they might be a string like "30"
fromQueryData :: QueryData -> Query
fromQueryData :: QueryData -> Query
fromQueryData QueryData
q =
  ((Param, Text) -> QueryItem) -> [(Param, Text)] -> Query
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Param, Text) -> QueryItem
toQueryItem ([(Param, Text)] -> Query) -> [(Param, Text)] -> Query
forall a b. (a -> b) -> a -> b
$ QueryData -> [Item QueryData]
forall l. IsList l => l -> [Item l]
toList QueryData
q
 where
  toQueryItem :: (Param, Text) -> QueryItem
  toQueryItem :: (Param, Text) -> QueryItem
toQueryItem (Param Text
prm, Text
pval) =
    (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
prm, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
pval)


{- ! Decode a type from a 'QueryData'. Missing fields are set to 'Data.Default.def'

@
#EMBED Example.Docs.Encoding data Filters
@

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

>>> parseQuery $ QueryData.parse "search=asdf"
Right (Filters False "asdf")
-}

{- | Decode a type from a 'QueryData'. Missing fields are set to 'Data.Default.def'

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

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

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


instance FromQuery QueryData where
  parseQuery :: QueryData -> Either String QueryData
parseQuery = QueryData -> Either String QueryData
forall a. a -> Either String 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

@
#EMBED Example.Docs.Encoding data Filters
@

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

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

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

>>> QueryData.render $ toQuery $ Filter False ""
""
-}

{- | 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, Eq, 'FromQuery', 'ToQuery')
@

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

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

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

>>> QueryData.render $ toQuery $ Filter False ""
""
-}
class ToQuery a where
  toQuery :: a -> QueryData
  default toQuery :: (Generic a, GToQuery (Rep a)) => a -> QueryData
  toQuery = Rep a (ZonkAny 1) -> QueryData
forall p. Rep a p -> QueryData
forall {k} (f :: k -> *) (p :: k). GToQuery f => f p -> QueryData
gToQuery (Rep a (ZonkAny 1) -> QueryData)
-> (a -> Rep a (ZonkAny 1)) -> a -> QueryData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rep a (ZonkAny 1)
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


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


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


instance (GFromQuery f) => GFromQuery (M1 D d f) where
  gParseQuery :: forall (p :: k). QueryData -> Either String (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 String (f p) -> Either String (M1 D d f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryData -> Either String (f p)
forall (p :: k). QueryData -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either String (f p)
gParseQuery QueryData
q


instance (GFromQuery f) => GFromQuery (M1 C c f) where
  gParseQuery :: forall (p :: k). QueryData -> Either String (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 String (f p) -> Either String (M1 C c f p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryData -> Either String (f p)
forall (p :: k). QueryData -> Either String (f p)
forall {k} (f :: k -> *) (p :: k).
GFromQuery f =>
QueryData -> Either String (f p)
gParseQuery QueryData
q


instance {-# OVERLAPPABLE #-} (Selector s, FromJSON a, Default a) => GFromQuery (M1 S s (K1 R a)) where
  gParseQuery :: forall (p :: k). QueryData -> Either String (M1 S s (K1 R a) p)
gParseQuery QueryData
q = do
    let s :: String
s = M1 S s (K1 R (ZonkAny 17 a)) (ZonkAny 16) -> 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. FromJSON 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 String (M1 S s (K1 R a) p)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M1 S s (K1 R a) p -> Either String (M1 S s (K1 R a) p))
-> M1 S s (K1 R a) p -> Either String (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. Default a => a
def Maybe a
mval


-- Text doesn't have a default instance. Annoying
instance {-# OVERLAPS #-} (Selector s) => GFromQuery (M1 S s (K1 R Text)) where
  gParseQuery :: forall (p :: k). QueryData -> Either String (M1 S s (K1 R Text) p)
gParseQuery QueryData
q = do
    let s :: String
s = M1 S s (K1 R (ZonkAny 13 (ZonkAny 14))) (ZonkAny 11) -> 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} {k} {f :: k -> *} {a :: k} {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 Text
mval = Param -> QueryData -> Maybe Text
forall a. FromJSON 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 Text) p -> Either String (M1 S s (K1 R Text) p)
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (M1 S s (K1 R Text) p -> Either String (M1 S s (K1 R Text) p))
-> M1 S s (K1 R Text) p -> Either String (M1 S s (K1 R Text) p)
forall a b. (a -> b) -> a -> b
$ K1 R Text p -> M1 S s (K1 R Text) p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (K1 R Text p -> M1 S s (K1 R Text) p)
-> K1 R Text p -> M1 S s (K1 R Text) p
forall a b. (a -> b) -> a -> b
$ Text -> K1 R Text p
forall k i c (p :: k). c -> K1 i c p
K1 (Text -> K1 R Text p) -> Text -> K1 R Text p
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
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 {-# OVERLAPPABLE #-} (Selector s, ToJSON a, Eq a, Default 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. Default a => a
def = 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 (ZonkAny 9 a)) (ZonkAny 8) -> 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. ToJSON a => Param -> a -> QueryData
singleton Param
sel a
a


-- Special case for Text, which has no Default instance
instance {-# OVERLAPS #-} (Selector s) => GToQuery (M1 S s (K1 R Text)) where
  gToQuery :: forall (p :: k). M1 S s (K1 R Text) p -> QueryData
gToQuery (M1 (K1 Text
a))
    | Text
a Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = 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 (ZonkAny 5 (ZonkAny 6))) (ZonkAny 3) -> 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} {k} {f :: k -> *} {a :: k} {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 -> Text -> QueryData
forall a. ToJSON a => Param -> a -> QueryData
singleton Param
sel Text
a

-- instance {-# OVERLAPS #-} (Selector s, ToJSON a, Eq a) => GToQuery (M1 S s (K1 R [a])) where
--   gToQuery (M1 (K1 a))
--     | a == [] = mempty
--     | otherwise =
--         let sel = Param $ pack $ selName (undefined :: M1 S s (K1 R (f a)) p)
--          in singleton sel $ Plusses a