{-# LANGUAGE GADTs #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.Free.UserQuery
  ( UserQuery (..),
    doesTokenMatchByEmail,
    UserQueryError (..),
    UserEmail (..),
    UserToken (..),
  )
where

import WikiMusic.Protolude

newtype UserEmail = UserEmail {UserEmail -> Text
value :: Text}
  deriving ((forall x. UserEmail -> Rep UserEmail x)
-> (forall x. Rep UserEmail x -> UserEmail) -> Generic UserEmail
forall x. Rep UserEmail x -> UserEmail
forall x. UserEmail -> Rep UserEmail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserEmail -> Rep UserEmail x
from :: forall x. UserEmail -> Rep UserEmail x
$cto :: forall x. Rep UserEmail x -> UserEmail
to :: forall x. Rep UserEmail x -> UserEmail
Generic, UserEmail -> UserEmail -> Bool
(UserEmail -> UserEmail -> Bool)
-> (UserEmail -> UserEmail -> Bool) -> Eq UserEmail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserEmail -> UserEmail -> Bool
== :: UserEmail -> UserEmail -> Bool
$c/= :: UserEmail -> UserEmail -> Bool
/= :: UserEmail -> UserEmail -> Bool
Eq, Int -> UserEmail -> ShowS
[UserEmail] -> ShowS
UserEmail -> String
(Int -> UserEmail -> ShowS)
-> (UserEmail -> String)
-> ([UserEmail] -> ShowS)
-> Show UserEmail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserEmail -> ShowS
showsPrec :: Int -> UserEmail -> ShowS
$cshow :: UserEmail -> String
show :: UserEmail -> String
$cshowList :: [UserEmail] -> ShowS
showList :: [UserEmail] -> ShowS
Show)

makeFieldLabelsNoPrefix ''UserEmail

newtype UserToken = UserToken {UserToken -> Text
value :: Text}
  deriving ((forall x. UserToken -> Rep UserToken x)
-> (forall x. Rep UserToken x -> UserToken) -> Generic UserToken
forall x. Rep UserToken x -> UserToken
forall x. UserToken -> Rep UserToken x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UserToken -> Rep UserToken x
from :: forall x. UserToken -> Rep UserToken x
$cto :: forall x. Rep UserToken x -> UserToken
to :: forall x. Rep UserToken x -> UserToken
Generic, UserToken -> UserToken -> Bool
(UserToken -> UserToken -> Bool)
-> (UserToken -> UserToken -> Bool) -> Eq UserToken
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UserToken -> UserToken -> Bool
== :: UserToken -> UserToken -> Bool
$c/= :: UserToken -> UserToken -> Bool
/= :: UserToken -> UserToken -> Bool
Eq, Int -> UserToken -> ShowS
[UserToken] -> ShowS
UserToken -> String
(Int -> UserToken -> ShowS)
-> (UserToken -> String)
-> ([UserToken] -> ShowS)
-> Show UserToken
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserToken -> ShowS
showsPrec :: Int -> UserToken -> ShowS
$cshow :: UserToken -> String
show :: UserToken -> String
$cshowList :: [UserToken] -> ShowS
showList :: [UserToken] -> ShowS
Show)

makeFieldLabelsNoPrefix ''UserToken

data UserQueryError = PersistenceError Text | LogicError Text deriving (Int -> UserQueryError -> ShowS
[UserQueryError] -> ShowS
UserQueryError -> String
(Int -> UserQueryError -> ShowS)
-> (UserQueryError -> String)
-> ([UserQueryError] -> ShowS)
-> Show UserQueryError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UserQueryError -> ShowS
showsPrec :: Int -> UserQueryError -> ShowS
$cshow :: UserQueryError -> String
show :: UserQueryError -> String
$cshowList :: [UserQueryError] -> ShowS
showList :: [UserQueryError] -> ShowS
Show)

data UserQuery a
  = DoesTokenMatchByEmail Env UserEmail UserToken (Either UserQueryError Bool -> a)
  deriving ((forall a b. (a -> b) -> UserQuery a -> UserQuery b)
-> (forall a b. a -> UserQuery b -> UserQuery a)
-> Functor UserQuery
forall a b. a -> UserQuery b -> UserQuery a
forall a b. (a -> b) -> UserQuery a -> UserQuery b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> UserQuery a -> UserQuery b
fmap :: forall a b. (a -> b) -> UserQuery a -> UserQuery b
$c<$ :: forall a b. a -> UserQuery b -> UserQuery a
<$ :: forall a b. a -> UserQuery b -> UserQuery a
Functor)

doesTokenMatchByEmail :: (UserQuery :<: f) => Env -> UserEmail -> UserToken -> Free f (Either UserQueryError Bool)
doesTokenMatchByEmail :: forall (f :: * -> *).
(UserQuery :<: f) =>
Env
-> UserEmail -> UserToken -> Free f (Either UserQueryError Bool)
doesTokenMatchByEmail Env
env UserEmail
userEmail UserToken
userToken = UserQuery (Free f (Either UserQueryError Bool))
-> Free f (Either UserQueryError Bool)
forall (g :: * -> *) (f :: * -> *) a.
(g :<: f) =>
g (Free f a) -> Free f a
injectFree (Env
-> UserEmail
-> UserToken
-> (Either UserQueryError Bool
    -> Free f (Either UserQueryError Bool))
-> UserQuery (Free f (Either UserQueryError Bool))
forall a.
Env
-> UserEmail
-> UserToken
-> (Either UserQueryError Bool -> a)
-> UserQuery a
DoesTokenMatchByEmail Env
env UserEmail
userEmail UserToken
userToken Either UserQueryError Bool -> Free f (Either UserQueryError Bool)
forall (f :: * -> *) a. a -> Free f a
Pure)