module ProjectM36.RegisteredQuery where
import ProjectM36.Base
import ProjectM36.Attribute
import ProjectM36.Error
import ProjectM36.IsomorphicSchema
import ProjectM36.Relation
import qualified Data.Map as M

registeredQueriesAsRelationInSchema :: Schema -> RegisteredQueries -> Either RelationalError Relation
registeredQueriesAsRelationInSchema :: Schema -> RegisteredQueries -> Either RelationalError Relation
registeredQueriesAsRelationInSchema Schema
schema RegisteredQueries
regQs = do
  [[Atom]]
tups <- ((Text, RelationalExpr) -> Either RelationalError [Atom])
-> [(Text, RelationalExpr)] -> Either RelationalError [[Atom]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text, RelationalExpr) -> Either RelationalError [Atom]
regQToTuple (RegisteredQueries -> [(Text, RelationalExpr)]
forall k a. Map k a -> [(k, a)]
M.toList RegisteredQueries
regQs)
  Attributes -> [[Atom]] -> Either RelationalError Relation
mkRelationFromList Attributes
attrs [[Atom]]
tups
  where
    attrs :: Attributes
attrs = [Attribute] -> Attributes
attributesFromList [Text -> AtomType -> Attribute
Attribute Text
"name" AtomType
TextAtomType,
                                Text -> AtomType -> Attribute
Attribute Text
"expr" AtomType
RelationalExprAtomType]
    regQToTuple :: (Text, RelationalExpr) -> Either RelationalError [Atom]
regQToTuple (Text
qname, RelationalExpr
qexpr) = do
      RelationalExpr
qexpr' <- Schema -> RelationalExpr -> Either RelationalError RelationalExpr
processRelationalExprInSchema Schema
schema RelationalExpr
qexpr
      [Atom] -> Either RelationalError [Atom]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Text -> Atom
TextAtom Text
qname, RelationalExpr -> Atom
RelationalExprAtom RelationalExpr
qexpr']