module Rakuten.Types.Class
( ToParam(..)
, ToParams(..)
) where
import Control.Applicative (liftA2)
import Data.Bool (bool)
import Data.Constraint
import Data.Default.Class (Default (..))
import Data.Extensible
import Data.Functor.Identity (Identity (..))
import Data.Monoid (Endo (..), (<>))
import Data.Proxy
import Data.String (fromString)
import Data.Text (Text)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Network.HTTP.Req (QueryParam, (=:))
instance Default a => Default (Identity a) where
def = Identity def
instance Default Text where
def = mempty
instance Forall (KeyValue KnownSymbol Default) xs => Default (Record xs) where
def = runIdentity $ hgenerateFor
(Proxy :: Proxy (KeyValue KnownSymbol Default)) (const $ pure (Field def))
class ToParam a where
toParam :: (QueryParam param, Monoid param) => Text -> a -> param
instance ToParam Int where
toParam = (=:)
instance ToParam Double where
toParam = (=:)
instance ToParam Text where
toParam _ "" = mempty
toParam name txt = name =: txt
instance ToParam Bool where
toParam name = (=:) name . bool 0 (1 :: Int)
instance ToParam [Text] where
toParam _ [] = mempty
toParam name xs = name =: foldl1 (\acc s -> acc <> "," <> s) (fmap show xs)
instance ToParam a => ToParam (Maybe a) where
toParam = maybe mempty . toParam
instance ToParam a => ToParam (Identity a) where
toParam name = toParam name . runIdentity
class ToParams a where
toParams :: (QueryParam param, Monoid param) => a -> param
instance Forall (KeyValue KnownSymbol ToParam) xs => ToParams (Record xs) where
toParams = flip appEndo mempty . hfoldMap getConst' . hzipWith
(\(Comp Dict) -> Const' . Endo . (<>) .
liftA2 toParam (fromString . symbolVal . proxyAssocKey) getField)
(library :: Comp Dict (KeyValue KnownSymbol ToParam) :* xs)