{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Module      : Test.KeyedVals.Type
Copyright   : (c) 2022 Tim Emiola
Maintainer  : Tim Emiola <adetokunbo@emio.la>
SPDX-License-Identifier: BSD3

This module provides types that demonstrate how to use @KeyVals.Handle.Typed@

The declared types are used in hspec tests used to validate implementations of 'Handle'
-}
module Test.KeyedVals.Types (
  -- * data types
  VarDemo (VarDemo),
  VarDemoKey,
  VarDemoID,
  FixedDemo (FixedDemo),
  FixedDemoKey,
) where

import Data.Aeson (FromJSON, ToJSON)
import Data.String (IsString)
import Data.Text (Text)
import KeyedVals.Handle.Codec.Aeson (AesonOf (..))
import KeyedVals.Handle.Codec.HttpApiData (HttpApiDataOf (..))
import KeyedVals.Handle.Typed
import Web.HttpApiData (FromHttpApiData (..), ToHttpApiData (..))


{- | A simple type to illustrate storing key-values at varying storage paths.

it's just a simple type (Either) wrapped in newtype to avoid orphan
instances.
-}
newtype VarDemo = VarDemo (Either Text Bool)
  deriving (VarDemo -> VarDemo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarDemo -> VarDemo -> Bool
$c/= :: VarDemo -> VarDemo -> Bool
== :: VarDemo -> VarDemo -> Bool
$c== :: VarDemo -> VarDemo -> Bool
Eq, Int -> VarDemo -> ShowS
[VarDemo] -> ShowS
VarDemo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarDemo] -> ShowS
$cshowList :: [VarDemo] -> ShowS
show :: VarDemo -> String
$cshow :: VarDemo -> String
showsPrec :: Int -> VarDemo -> ShowS
$cshowsPrec :: Int -> VarDemo -> ShowS
Show)
  deriving (Value -> Parser [VarDemo]
Value -> Parser VarDemo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [VarDemo]
$cparseJSONList :: Value -> Parser [VarDemo]
parseJSON :: Value -> Parser VarDemo
$cparseJSON :: Value -> Parser VarDemo
FromJSON, [VarDemo] -> Encoding
[VarDemo] -> Value
VarDemo -> Encoding
VarDemo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [VarDemo] -> Encoding
$ctoEncodingList :: [VarDemo] -> Encoding
toJSONList :: [VarDemo] -> Value
$ctoJSONList :: [VarDemo] -> Value
toEncoding :: VarDemo -> Encoding
$ctoEncoding :: VarDemo -> Encoding
toJSON :: VarDemo -> Value
$ctoJSON :: VarDemo -> Value
ToJSON) via (Either Text Bool)


deriving via (AesonOf (Either Text Bool)) instance DecodeKV VarDemo


deriving via (AesonOf (Either Text Bool)) instance EncodeKV VarDemo


-- | The keys for each 'VarDemo' are @Int@s.
newtype VarDemoKey = VarDemoKey Int
  deriving stock (VarDemoKey -> VarDemoKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarDemoKey -> VarDemoKey -> Bool
$c/= :: VarDemoKey -> VarDemoKey -> Bool
== :: VarDemoKey -> VarDemoKey -> Bool
$c== :: VarDemoKey -> VarDemoKey -> Bool
Eq, Int -> VarDemoKey -> ShowS
[VarDemoKey] -> ShowS
VarDemoKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarDemoKey] -> ShowS
$cshowList :: [VarDemoKey] -> ShowS
show :: VarDemoKey -> String
$cshow :: VarDemoKey -> String
showsPrec :: Int -> VarDemoKey -> ShowS
$cshowsPrec :: Int -> VarDemoKey -> ShowS
Show)
  deriving (VarDemoKey -> Val
VarDemoKey -> Builder
VarDemoKey -> Text
forall a.
(a -> Text)
-> (a -> Builder) -> (a -> Val) -> (a -> Text) -> ToHttpApiData a
toQueryParam :: VarDemoKey -> Text
$ctoQueryParam :: VarDemoKey -> Text
toHeader :: VarDemoKey -> Val
$ctoHeader :: VarDemoKey -> Val
toEncodedUrlPiece :: VarDemoKey -> Builder
$ctoEncodedUrlPiece :: VarDemoKey -> Builder
toUrlPiece :: VarDemoKey -> Text
$ctoUrlPiece :: VarDemoKey -> Text
ToHttpApiData, Val -> Either Text VarDemoKey
Text -> Either Text VarDemoKey
forall a.
(Text -> Either Text a)
-> (Val -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text VarDemoKey
$cparseQueryParam :: Text -> Either Text VarDemoKey
parseHeader :: Val -> Either Text VarDemoKey
$cparseHeader :: Val -> Either Text VarDemoKey
parseUrlPiece :: Text -> Either Text VarDemoKey
$cparseUrlPiece :: Text -> Either Text VarDemoKey
FromHttpApiData, Integer -> VarDemoKey
VarDemoKey -> VarDemoKey
VarDemoKey -> VarDemoKey -> VarDemoKey
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> VarDemoKey
$cfromInteger :: Integer -> VarDemoKey
signum :: VarDemoKey -> VarDemoKey
$csignum :: VarDemoKey -> VarDemoKey
abs :: VarDemoKey -> VarDemoKey
$cabs :: VarDemoKey -> VarDemoKey
negate :: VarDemoKey -> VarDemoKey
$cnegate :: VarDemoKey -> VarDemoKey
* :: VarDemoKey -> VarDemoKey -> VarDemoKey
$c* :: VarDemoKey -> VarDemoKey -> VarDemoKey
- :: VarDemoKey -> VarDemoKey -> VarDemoKey
$c- :: VarDemoKey -> VarDemoKey -> VarDemoKey
+ :: VarDemoKey -> VarDemoKey -> VarDemoKey
$c+ :: VarDemoKey -> VarDemoKey -> VarDemoKey
Num, Eq VarDemoKey
VarDemoKey -> VarDemoKey -> Bool
VarDemoKey -> VarDemoKey -> Ordering
VarDemoKey -> VarDemoKey -> VarDemoKey
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
min :: VarDemoKey -> VarDemoKey -> VarDemoKey
$cmin :: VarDemoKey -> VarDemoKey -> VarDemoKey
max :: VarDemoKey -> VarDemoKey -> VarDemoKey
$cmax :: VarDemoKey -> VarDemoKey -> VarDemoKey
>= :: VarDemoKey -> VarDemoKey -> Bool
$c>= :: VarDemoKey -> VarDemoKey -> Bool
> :: VarDemoKey -> VarDemoKey -> Bool
$c> :: VarDemoKey -> VarDemoKey -> Bool
<= :: VarDemoKey -> VarDemoKey -> Bool
$c<= :: VarDemoKey -> VarDemoKey -> Bool
< :: VarDemoKey -> VarDemoKey -> Bool
$c< :: VarDemoKey -> VarDemoKey -> Bool
compare :: VarDemoKey -> VarDemoKey -> Ordering
$ccompare :: VarDemoKey -> VarDemoKey -> Ordering
Ord) via Int
  deriving (Val -> Either Text VarDemoKey
forall a. (Val -> Either Text a) -> DecodeKV a
decodeKV :: Val -> Either Text VarDemoKey
$cdecodeKV :: Val -> Either Text VarDemoKey
DecodeKV, VarDemoKey -> Val
forall a. (a -> Val) -> EncodeKV a
encodeKV :: VarDemoKey -> Val
$cencodeKV :: VarDemoKey -> Val
EncodeKV) via HttpApiDataOf Int


-- | Groups of 'VarDemo' are stored for different 'VarDemoID'.
newtype VarDemoID = VarDemoId Text
  deriving stock (VarDemoID -> VarDemoID -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VarDemoID -> VarDemoID -> Bool
$c/= :: VarDemoID -> VarDemoID -> Bool
== :: VarDemoID -> VarDemoID -> Bool
$c== :: VarDemoID -> VarDemoID -> Bool
Eq, Int -> VarDemoID -> ShowS
[VarDemoID] -> ShowS
VarDemoID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VarDemoID] -> ShowS
$cshowList :: [VarDemoID] -> ShowS
show :: VarDemoID -> String
$cshow :: VarDemoID -> String
showsPrec :: Int -> VarDemoID -> ShowS
$cshowsPrec :: Int -> VarDemoID -> ShowS
Show)
  deriving (String -> VarDemoID
forall a. (String -> a) -> IsString a
fromString :: String -> VarDemoID
$cfromString :: String -> VarDemoID
IsString, VarDemoID -> Val
VarDemoID -> Builder
VarDemoID -> Text
forall a.
(a -> Text)
-> (a -> Builder) -> (a -> Val) -> (a -> Text) -> ToHttpApiData a
toQueryParam :: VarDemoID -> Text
$ctoQueryParam :: VarDemoID -> Text
toHeader :: VarDemoID -> Val
$ctoHeader :: VarDemoID -> Val
toEncodedUrlPiece :: VarDemoID -> Builder
$ctoEncodedUrlPiece :: VarDemoID -> Builder
toUrlPiece :: VarDemoID -> Text
$ctoUrlPiece :: VarDemoID -> Text
ToHttpApiData, Val -> Either Text VarDemoID
Text -> Either Text VarDemoID
forall a.
(Text -> Either Text a)
-> (Val -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text VarDemoID
$cparseQueryParam :: Text -> Either Text VarDemoID
parseHeader :: Val -> Either Text VarDemoID
$cparseHeader :: Val -> Either Text VarDemoID
parseUrlPiece :: Text -> Either Text VarDemoID
$cparseUrlPiece :: Text -> Either Text VarDemoID
FromHttpApiData) via Text
  deriving (Val -> Either Text VarDemoID
forall a. (Val -> Either Text a) -> DecodeKV a
decodeKV :: Val -> Either Text VarDemoID
$cdecodeKV :: Val -> Either Text VarDemoID
DecodeKV, VarDemoID -> Val
forall a. (a -> Val) -> EncodeKV a
encodeKV :: VarDemoID -> Val
$cencodeKV :: VarDemoID -> Val
EncodeKV) via HttpApiDataOf Text


-- | Describe how @'VarDemo's@ are stored in the key-value store
instance PathOf VarDemo where
  type KVPath VarDemo = "/testing/{}/var"
  type KeyType VarDemo = VarDemoKey


{- | Specify how to derive the path to store @'VarDemo's@ in the key-value store

This instance uses 'expand' to replace the @{}@ in the 'KVPath' with the
variable portion of the key.
-}
instance VaryingPathOf VarDemo where
  type PathVar VarDemo = VarDemoID
  modifyPath :: Proxy VarDemo -> PathVar VarDemo -> Val -> Val
modifyPath Proxy VarDemo
_ = forall a. EncodeKV a => a -> Val -> Val
expand


{- | A simple type to illustrate storing key-values at a fixed storage path

it's just a simple type (tuple) wrapped in newtype to avoid orphan instances.
-}
newtype FixedDemo = FixedDemo (Int, Text)
  deriving stock (FixedDemo -> FixedDemo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixedDemo -> FixedDemo -> Bool
$c/= :: FixedDemo -> FixedDemo -> Bool
== :: FixedDemo -> FixedDemo -> Bool
$c== :: FixedDemo -> FixedDemo -> Bool
Eq, Int -> FixedDemo -> ShowS
[FixedDemo] -> ShowS
FixedDemo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedDemo] -> ShowS
$cshowList :: [FixedDemo] -> ShowS
show :: FixedDemo -> String
$cshow :: FixedDemo -> String
showsPrec :: Int -> FixedDemo -> ShowS
$cshowsPrec :: Int -> FixedDemo -> ShowS
Show)
  deriving (Value -> Parser [FixedDemo]
Value -> Parser FixedDemo
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [FixedDemo]
$cparseJSONList :: Value -> Parser [FixedDemo]
parseJSON :: Value -> Parser FixedDemo
$cparseJSON :: Value -> Parser FixedDemo
FromJSON, [FixedDemo] -> Encoding
[FixedDemo] -> Value
FixedDemo -> Encoding
FixedDemo -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FixedDemo] -> Encoding
$ctoEncodingList :: [FixedDemo] -> Encoding
toJSONList :: [FixedDemo] -> Value
$ctoJSONList :: [FixedDemo] -> Value
toEncoding :: FixedDemo -> Encoding
$ctoEncoding :: FixedDemo -> Encoding
toJSON :: FixedDemo -> Value
$ctoJSON :: FixedDemo -> Value
ToJSON) via (Int, Text)
  deriving (Val -> Either Text FixedDemo
forall a. (Val -> Either Text a) -> DecodeKV a
decodeKV :: Val -> Either Text FixedDemo
$cdecodeKV :: Val -> Either Text FixedDemo
DecodeKV, FixedDemo -> Val
forall a. (a -> Val) -> EncodeKV a
encodeKV :: FixedDemo -> Val
$cencodeKV :: FixedDemo -> Val
EncodeKV) via AesonOf (Int, Text)


-- | Specify how @'FixedDemo's@ are stored in the key-value store
instance PathOf FixedDemo where
  type KVPath FixedDemo = "/testing/fixed"
  type KeyType FixedDemo = FixedDemoKey


-- | The keys for each 'FixedDemo' are @Int@s.
newtype FixedDemoKey = FixedDemoKey Int
  deriving stock (FixedDemoKey -> FixedDemoKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FixedDemoKey -> FixedDemoKey -> Bool
$c/= :: FixedDemoKey -> FixedDemoKey -> Bool
== :: FixedDemoKey -> FixedDemoKey -> Bool
$c== :: FixedDemoKey -> FixedDemoKey -> Bool
Eq, Int -> FixedDemoKey -> ShowS
[FixedDemoKey] -> ShowS
FixedDemoKey -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FixedDemoKey] -> ShowS
$cshowList :: [FixedDemoKey] -> ShowS
show :: FixedDemoKey -> String
$cshow :: FixedDemoKey -> String
showsPrec :: Int -> FixedDemoKey -> ShowS
$cshowsPrec :: Int -> FixedDemoKey -> ShowS
Show)
  deriving (FixedDemoKey -> Val
FixedDemoKey -> Builder
FixedDemoKey -> Text
forall a.
(a -> Text)
-> (a -> Builder) -> (a -> Val) -> (a -> Text) -> ToHttpApiData a
toQueryParam :: FixedDemoKey -> Text
$ctoQueryParam :: FixedDemoKey -> Text
toHeader :: FixedDemoKey -> Val
$ctoHeader :: FixedDemoKey -> Val
toEncodedUrlPiece :: FixedDemoKey -> Builder
$ctoEncodedUrlPiece :: FixedDemoKey -> Builder
toUrlPiece :: FixedDemoKey -> Text
$ctoUrlPiece :: FixedDemoKey -> Text
ToHttpApiData, Val -> Either Text FixedDemoKey
Text -> Either Text FixedDemoKey
forall a.
(Text -> Either Text a)
-> (Val -> Either Text a)
-> (Text -> Either Text a)
-> FromHttpApiData a
parseQueryParam :: Text -> Either Text FixedDemoKey
$cparseQueryParam :: Text -> Either Text FixedDemoKey
parseHeader :: Val -> Either Text FixedDemoKey
$cparseHeader :: Val -> Either Text FixedDemoKey
parseUrlPiece :: Text -> Either Text FixedDemoKey
$cparseUrlPiece :: Text -> Either Text FixedDemoKey
FromHttpApiData, Integer -> FixedDemoKey
FixedDemoKey -> FixedDemoKey
FixedDemoKey -> FixedDemoKey -> FixedDemoKey
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> FixedDemoKey
$cfromInteger :: Integer -> FixedDemoKey
signum :: FixedDemoKey -> FixedDemoKey
$csignum :: FixedDemoKey -> FixedDemoKey
abs :: FixedDemoKey -> FixedDemoKey
$cabs :: FixedDemoKey -> FixedDemoKey
negate :: FixedDemoKey -> FixedDemoKey
$cnegate :: FixedDemoKey -> FixedDemoKey
* :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
$c* :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
- :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
$c- :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
+ :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
$c+ :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
Num, Eq FixedDemoKey
FixedDemoKey -> FixedDemoKey -> Bool
FixedDemoKey -> FixedDemoKey -> Ordering
FixedDemoKey -> FixedDemoKey -> FixedDemoKey
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
min :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
$cmin :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
max :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
$cmax :: FixedDemoKey -> FixedDemoKey -> FixedDemoKey
>= :: FixedDemoKey -> FixedDemoKey -> Bool
$c>= :: FixedDemoKey -> FixedDemoKey -> Bool
> :: FixedDemoKey -> FixedDemoKey -> Bool
$c> :: FixedDemoKey -> FixedDemoKey -> Bool
<= :: FixedDemoKey -> FixedDemoKey -> Bool
$c<= :: FixedDemoKey -> FixedDemoKey -> Bool
< :: FixedDemoKey -> FixedDemoKey -> Bool
$c< :: FixedDemoKey -> FixedDemoKey -> Bool
compare :: FixedDemoKey -> FixedDemoKey -> Ordering
$ccompare :: FixedDemoKey -> FixedDemoKey -> Ordering
Ord) via Int
  deriving (Val -> Either Text FixedDemoKey
forall a. (Val -> Either Text a) -> DecodeKV a
decodeKV :: Val -> Either Text FixedDemoKey
$cdecodeKV :: Val -> Either Text FixedDemoKey
DecodeKV, FixedDemoKey -> Val
forall a. (a -> Val) -> EncodeKV a
encodeKV :: FixedDemoKey -> Val
$cencodeKV :: FixedDemoKey -> Val
EncodeKV) via HttpApiDataOf Int