module Experimenter.Parameter.Query
    ( queryParamSettings
    ) where

import           Control.Monad.Reader
import           Database.Esqueleto
import           Prelude              hiding (exp)

import           Experimenter.Models


queryParamSettings :: (MonadIO m) => Key Exp -> ReaderT SqlBackend m [(Entity Exp, Entity ParamSetting)]
queryParamSettings :: forall (m :: * -> *).
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [(Entity Exp, Entity ParamSetting)]
queryParamSettings Key Exp
kExp =
  forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select forall a b. (a -> b) -> a -> b
$
  forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
from forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity Exp)
exp, SqlExpr (Entity ParamSetting)
paramSet) -> do
    SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Exp)
exp forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Exp) => EntityField Exp typ
ExpId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. SqlExpr (Entity ParamSetting)
paramSet forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Exp) => EntityField ParamSetting typ
ParamSettingExp)
    SqlExpr (Value Bool) -> SqlQuery ()
where_ (SqlExpr (Entity Exp)
exp forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Key Exp) => EntityField Exp typ
ExpId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
val Key Exp
kExp)
    [SqlExpr OrderBy] -> SqlQuery ()
orderBy [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
asc (SqlExpr (Entity Exp)
exp forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
^. forall typ. (typ ~ Int) => EntityField Exp typ
ExpNumber)]
    forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity Exp)
exp, SqlExpr (Entity ParamSetting)
paramSet)