{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
module ProjectM36.Shortcuts where
-- users need OverloadedLabels, OverloadedLists, and default(Int,Text) to use these shortcuts.
import Data.Text hiding (foldl, map)
import ProjectM36.Base
import ProjectM36.Relation
import ProjectM36.Atomable
import Prelude hiding ((!!))
import Data.Proxy
import GHC.OverloadedLabels
import GHC.TypeLits hiding (Text)
import qualified Data.Text as T
import qualified Data.Map as M
import qualified Data.Set as S
import GHC.Exts (IsList(..))
import Data.Convertible

default (Text)

instance IsList (AttributeNamesBase ()) where
  type Item (AttributeNamesBase ()) = AttributeName
  fromList :: [Item (AttributeNamesBase ())] -> AttributeNamesBase ()
fromList = forall a. Set AttributeName -> AttributeNamesBase a
AttributeNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList 
  toList :: AttributeNamesBase () -> [Item (AttributeNamesBase ())]
toList (AttributeNames Set AttributeName
ns) = forall a. Set a -> [a]
S.toList Set AttributeName
ns
  toList AttributeNamesBase ()
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"needs AttributeNames"

instance IsList (TupleExprsBase ()) where
  type Item TupleExprs = TupleExpr
  fromList :: [Item (TupleExprsBase ())] -> TupleExprsBase ()
fromList = forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs ()
  toList :: TupleExprsBase () -> [Item (TupleExprsBase ())]
toList (TupleExprs ()
_ [TupleExpr]
ts) = [TupleExpr]
ts

instance IsList TupleExpr where
  type Item TupleExpr = (AttributeName, AtomExpr) 
  fromList :: [Item TupleExpr] -> TupleExpr
fromList [Item TupleExpr]
attributeValues = forall a. Map AttributeName (AtomExprBase a) -> TupleExprBase a
TupleExpr (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [Item TupleExpr]
attributeValues)
  toList :: TupleExpr -> [Item TupleExpr]
toList (TupleExpr Map AttributeName (AtomExprBase ())
attributeValues) = forall k a. Map k a -> [(k, a)]
M.toList Map AttributeName (AtomExprBase ())
attributeValues


-- #xxx :: Text
instance KnownSymbol x => IsLabel x Text where
  fromLabel :: AttributeName
fromLabel = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy

-- #relvarName :: RelationalExpr
instance KnownSymbol x => IsLabel x RelationalExpr where
  fromLabel :: RelationalExpr
fromLabel = forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable ([Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy) ()

-- *Main> #a Int :: AttributeExpr
-- NakedAttributeExpr (Attribute "a" IntAtomType)
-- *Main> #a (Attr @[Int]) :: AttributeExpr
-- NakedAttributeExpr (Attribute "a" (ConstructedAtomType "List" (fromList [("a",IntAtomType)])))
-- can't offer a Relation atomtype -- don't know how to express a Relation type in haskell type. Maybe something a HList of (Text, a) ?
--
-- ps. I don't understand the usage of "AttributeAndTypeNameExpr AttributeName TypeConstructor a"
instance (KnownSymbol x, Atomable a)=> IsLabel x (HaskAtomType a -> AttributeExpr) where
  fromLabel :: HaskAtomType a -> AttributeExpr
fromLabel = (forall a. Attribute -> AttributeExprBase a
NakedAttributeExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttributeName -> AtomType -> Attribute
Attribute AttributeName
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Atomable a => HaskAtomType a -> AtomType
toAtomType''
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy

-- (#a 1) :: ExtendTupleExpr
-- no need for :=
instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> ExtendTupleExpr) where
  fromLabel :: a -> ExtendTupleExpr
fromLabel a
x = forall a. AttributeName -> AtomExprBase a -> ExtendTupleExprBase a
AttributeExtendTupleExpr AttributeName
name (forall a b. Convertible a b => a -> b
convert a
x) 
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy

-- #name AtomExpr 
-- ex. tuple [ #name 3 ]
-- default(Text) is needed in client code to avoid `no Atomable Char`
instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> (AttributeName, AtomExpr)) where
  fromLabel :: a -> (AttributeName, AtomExprBase ())
fromLabel = \a
x -> (AttributeName
name, forall a b. Convertible a b => a -> b
convert a
x)
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy

-- *Main> #a [1] :: AtomExpr
-- FunctionAtomExpr "a" [NakedAtomExpr (IntegerAtom 1)] ()
--
-- This usage is not working in RestrictionPredicateExpr and AttributeExtendTupleExpr. Use f "a" [1] instead.
instance (KnownSymbol x, Convertible a AtomExpr) => IsLabel x ([a] -> AtomExpr) where
  fromLabel :: [a] -> AtomExprBase ()
fromLabel = \[a]
as' -> forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
name (forall a b. (a -> b) -> [a] -> [b]
map forall a b. Convertible a b => a -> b
convert [a]
as') ()
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy

instance (KnownSymbol x) => IsLabel x AtomExpr where
  fromLabel :: AtomExprBase ()
fromLabel = forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr AttributeName
name
    where name :: AttributeName
name = [Char] -> AttributeName
T.pack forall a b. (a -> b) -> a -> b
$ forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> [Char]
symbolVal @x forall {k} (t :: k). Proxy t
Proxy


data HaskAtomType a where
  Int :: HaskAtomType Int
  Integer :: HaskAtomType Integer
  Double :: HaskAtomType Double
  Text :: HaskAtomType Text
--  Day :: HaskAtomType Day
--  DateTime :: HaskAtomType DateTime
--  ByteString :: HaskAtomType ByteString
  Bool :: HaskAtomType Bool
  Attr :: Atomable a => HaskAtomType a  -- a Proxy-like value for type application.

toAtomType'' :: Atomable a => HaskAtomType a -> AtomType
toAtomType'' :: forall a. Atomable a => HaskAtomType a -> AtomType
toAtomType'' (HaskAtomType a
_ :: HaskAtomType a) = forall a (proxy :: * -> *). Atomable a => proxy a -> AtomType
toAtomType (forall {k} (t :: k). Proxy t
Proxy @a)

-- usage: relation [tuple [#a 1, #b "b"], tuple [#a 2, #b "b"]]
relation :: [TupleExpr] -> RelationalExpr
relation :: [TupleExpr] -> RelationalExpr
relation [TupleExpr]
ts = forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs forall a. Maybe a
Nothing (forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [TupleExpr]
ts)

relation' :: [AttributeExprBase ()] -> [TupleExpr] -> RelationalExpr
relation' :: [AttributeExpr] -> [TupleExpr] -> RelationalExpr
relation' [AttributeExpr]
as' [TupleExpr]
ts = forall a.
Maybe [AttributeExprBase a]
-> TupleExprsBase a -> RelationalExprBase a
MakeRelationFromExprs (forall a. a -> Maybe a
Just [AttributeExpr]
as') (forall a. a -> [TupleExprBase a] -> TupleExprsBase a
TupleExprs () [TupleExpr]
ts)

-- usage: tuple [#name "Mike",#age 6]
tuple :: [(AttributeName, AtomExpr)] -> TupleExprBase ()
tuple :: [(AttributeName, AtomExprBase ())] -> TupleExpr
tuple [(AttributeName, AtomExprBase ())]
as' = forall a. Map AttributeName (AtomExprBase a) -> TupleExprBase a
TupleExpr (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(AttributeName, AtomExprBase ())]
as')

-- #a rename  [#b `as` #c]
rename :: RelationalExpr -> [(AttributeName,AttributeName)] -> RelationalExpr 
rename :: RelationalExpr
-> [(AttributeName, AttributeName)] -> RelationalExpr
rename RelationalExpr
relExpr [(AttributeName, AttributeName)]
renameList = case [(AttributeName, AttributeName)]
renameList of 
  [] -> forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict forall a. RestrictionPredicateExprBase a
TruePredicate RelationalExpr
relExpr
  [(AttributeName, AttributeName)]
renames -> 
    forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\RelationalExpr
acc (AttributeName
old,AttributeName
new) -> forall a.
AttributeName
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Rename AttributeName
old AttributeName
new  RelationalExpr
acc) RelationalExpr
relExpr [(AttributeName, AttributeName)]
renames 

--project !!
-- #a !! [#b,#c]
infix 9 !!
(!!) :: RelationalExpr -> AttributeNames -> RelationalExpr  
RelationalExpr
relExpr !! :: RelationalExpr -> AttributeNamesBase () -> RelationalExpr
!! AttributeNamesBase ()
xs = forall a.
AttributeNamesBase a
-> RelationalExprBase a -> RelationalExprBase a
Project AttributeNamesBase ()
xs RelationalExpr
relExpr

--join ><
-- #a >< #b
(><) :: RelationalExpr -> RelationalExpr -> RelationalExpr
RelationalExpr
a >< :: RelationalExpr -> RelationalExpr -> RelationalExpr
>< RelationalExpr
b = forall a.
RelationalExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Join RelationalExpr
a RelationalExpr
b

allBut :: AttributeNames -> AttributeNames
allBut :: AttributeNamesBase () -> AttributeNamesBase ()
allBut (AttributeNames Set AttributeName
ns) = forall a. Set AttributeName -> AttributeNamesBase a
InvertedAttributeNames Set AttributeName
ns
allBut AttributeNamesBase ()
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"give allBut something other than attribute names."

allFrom :: RelationalExpr -> AttributeNames
allFrom :: RelationalExpr -> AttributeNamesBase ()
allFrom = forall a. RelationalExprBase a -> AttributeNamesBase a
RelationalExprAttributeNames 

as :: AttributeNames -> AttributeName -> (AttributeNames, AttributeName)
as :: AttributeNamesBase ()
-> AttributeName -> (AttributeNamesBase (), AttributeName)
as = (,)

-- #a `group` ([#b,#c] `as` #d)
group :: RelationalExpr -> (AttributeNames, AttributeName) -> RelationalExpr
group :: RelationalExpr
-> (AttributeNamesBase (), AttributeName) -> RelationalExpr
group RelationalExpr
relExpr (AttributeNamesBase ()
aNames, AttributeName
aName) = forall a.
AttributeNamesBase a
-> AttributeName -> RelationalExprBase a -> RelationalExprBase a
Group AttributeNamesBase ()
aNames AttributeName
aName RelationalExpr
relExpr

-- #a `ungroup` #b
ungroup :: RelationalExpr -> AttributeName -> RelationalExpr
ungroup :: RelationalExpr -> AttributeName -> RelationalExpr
ungroup RelationalExpr
relExpr AttributeName
aName = forall a.
AttributeName -> RelationalExprBase a -> RelationalExprBase a
Ungroup AttributeName
aName RelationalExpr
relExpr

-- *Main> #a #:= true #: ( #b (f "count" [1,2]))
-- Assign "a" (Extend (AttributeExtendTupleExpr "b" (FunctionAtomExpr "count" [NakedAtomExpr (IntegerAtom 1),NakedAtomExpr (IntegerAtom 2)] ())) (ExistingRelation (Relation attributesFromList [] (RelationTupleSet {asList = [RelationTuple attributesFromList [] []]}))))
(#:) :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr
RelationalExpr
a #: :: RelationalExpr -> ExtendTupleExpr -> RelationalExpr
#: ExtendTupleExpr
b = forall a.
ExtendTupleExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Extend ExtendTupleExpr
b RelationalExpr
a
infix 8 #:

instance Convertible AtomExpr AtomExpr where
  safeConvert :: AtomExprBase () -> ConvertResult (AtomExprBase ())
safeConvert = forall a b. b -> Either a b
Right

instance Convertible RelVarName AtomExpr where
  safeConvert :: AttributeName -> ConvertResult (AtomExprBase ())
safeConvert AttributeName
n = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr (forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
n ()) 

instance Convertible RelationalExpr AtomExpr where
  safeConvert :: RelationalExpr -> ConvertResult (AtomExprBase ())
safeConvert RelationalExpr
relExpr = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. RelationalExprBase a -> AtomExprBase a
RelationAtomExpr RelationalExpr
relExpr

instance Convertible RelVarName RelationalExpr where
  safeConvert :: AttributeName -> ConvertResult RelationalExpr
safeConvert AttributeName
n = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. AttributeName -> a -> RelationalExprBase a
RelationVariable AttributeName
n ()

-- @ in tutd
-- (@@) "aaa"
(@@) :: AttributeName -> AtomExpr
@@ :: AttributeName -> AtomExprBase ()
(@@) = forall a. AttributeName -> AtomExprBase a
AttributeAtomExpr 

-- works in RestrictedPredicateExpr and AttributeExtendTupleExpr 
-- usage: f "gte" [1]
f :: Convertible a AtomExpr => FunctionName -> [a] -> AtomExpr
f :: forall a.
Convertible a (AtomExprBase ()) =>
AttributeName -> [a] -> AtomExprBase ()
f AttributeName
n [a]
as' = forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
FunctionAtomExpr AttributeName
n (forall a b. (a -> b) -> [a] -> [b]
map forall a b. Convertible a b => a -> b
convert [a]
as') ()

-- DatabaseContextExpr
-- define
(#::) :: RelVarName -> [AttributeExpr] -> DatabaseContextExpr
AttributeName
s #:: :: AttributeName -> [AttributeExpr] -> DatabaseContextExpr
#:: [AttributeExpr]
xs =  forall a.
AttributeName -> [AttributeExprBase a] -> DatabaseContextExprBase a
Define AttributeName
s [AttributeExpr]
xs
infix 5 #::

-- assign
(#:=) :: RelVarName -> RelationalExpr -> DatabaseContextExpr 
AttributeName
s #:= :: AttributeName -> RelationalExpr -> DatabaseContextExpr
#:= RelationalExpr
r = forall a.
AttributeName -> RelationalExprBase a -> DatabaseContextExprBase a
Assign AttributeName
s RelationalExpr
r
infix 5 #:=

class Boolean a b where
  (&&&) :: a -> b -> RestrictionPredicateExpr
  infixl 6 &&&
  (|||) :: a -> b -> RestrictionPredicateExpr
  infixl 5 |||

-- where: @~ mimics the restriction symbol in algebra  
-- usage: true #: (#a 1) @~ #a ?= 1 &&& not' false ||| (f "gte" [1])
(@~) :: Convertible a RestrictionPredicateExpr => RelationalExpr -> a -> RelationalExpr
@~ :: forall a.
Convertible a RestrictionPredicateExpr =>
RelationalExpr -> a -> RelationalExpr
(@~) RelationalExpr
relExpr a
resPreExpr = forall a.
RestrictionPredicateExprBase a
-> RelationalExprBase a -> RelationalExprBase a
Restrict (forall a b. Convertible a b => a -> b
convert a
resPreExpr) RelationalExpr
relExpr
infix 4 @~

true :: RelationalExpr
true :: RelationalExpr
true = forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationTrue

false :: RelationalExpr
false :: RelationalExpr
false = forall a. Relation -> RelationalExprBase a
ExistingRelation Relation
relationFalse

trueP :: RestrictionPredicateExprBase a
trueP :: forall a. RestrictionPredicateExprBase a
trueP = forall a. RestrictionPredicateExprBase a
TruePredicate

falseP :: RestrictionPredicateExprBase a
falseP :: forall a. RestrictionPredicateExprBase a
falseP = forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate forall a. RestrictionPredicateExprBase a
TruePredicate

(?=) :: Convertible a AtomExpr => AttributeName -> a -> RestrictionPredicateExpr
?= :: forall a.
Convertible a (AtomExprBase ()) =>
AttributeName -> a -> RestrictionPredicateExpr
(?=) AttributeName
name a
a = forall a.
AttributeName -> AtomExprBase a -> RestrictionPredicateExprBase a
AttributeEqualityPredicate AttributeName
name (forall a b. Convertible a b => a -> b
convert a
a)
infix 9 ?=

not' :: Convertible a RestrictionPredicateExpr => a -> RestrictionPredicateExpr
not' :: forall a.
Convertible a RestrictionPredicateExpr =>
a -> RestrictionPredicateExpr
not' = forall a.
RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
NotPredicate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Convertible a b => a -> b
convert

instance (Convertible a RestrictionPredicateExpr, Convertible b RestrictionPredicateExpr) => Boolean a b where
  a
a &&& :: a -> b -> RestrictionPredicateExpr
&&& b
b = forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
AndPredicate (forall a b. Convertible a b => a -> b
convert a
a) (forall a b. Convertible a b => a -> b
convert b
b) 
  a
a ||| :: a -> b -> RestrictionPredicateExpr
||| b
b = forall a.
RestrictionPredicateExprBase a
-> RestrictionPredicateExprBase a -> RestrictionPredicateExprBase a
OrPredicate (forall a b. Convertible a b => a -> b
convert a
a) (forall a b. Convertible a b => a -> b
convert b
b)

instance {-# Incoherent #-} Atomable a => Convertible a RestrictionPredicateExpr where
  safeConvert :: a -> ConvertResult RestrictionPredicateExpr
safeConvert a
n = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate forall a b. (a -> b) -> a -> b
$ Atom -> AtomExprBase ()
toAtomExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Atomable a => a -> Atom
toAtom forall a b. (a -> b) -> a -> b
$ a
n 

instance {-# Incoherent #-} Convertible RelationalExpr RestrictionPredicateExpr where
  safeConvert :: RelationalExpr -> ConvertResult RestrictionPredicateExpr
safeConvert RelationalExpr
a = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. RelationalExprBase a -> RestrictionPredicateExprBase a
RelationalExprPredicate RelationalExpr
a
 
instance {-# Incoherent #-} Convertible AtomExpr RestrictionPredicateExpr where
  safeConvert :: AtomExprBase () -> ConvertResult RestrictionPredicateExpr
safeConvert AtomExprBase ()
a = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a. AtomExprBase a -> RestrictionPredicateExprBase a
AtomExprPredicate AtomExprBase ()
a

instance {-# Incoherent #-} Convertible RestrictionPredicateExpr RestrictionPredicateExpr where
  safeConvert :: RestrictionPredicateExpr -> ConvertResult RestrictionPredicateExpr
safeConvert = forall a b. b -> Either a b
Right

instance {-# Incoherent #-} Atomable a => Convertible a AtomExpr where
  safeConvert :: a -> ConvertResult (AtomExprBase ())
safeConvert a
n = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Atom -> AtomExprBase ()
toAtomExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Atomable a => a -> Atom
toAtom forall a b. (a -> b) -> a -> b
$ a
n 

toAtomExpr :: Atom -> AtomExpr
toAtomExpr :: Atom -> AtomExprBase ()
toAtomExpr (ConstructedAtom AttributeName
n AtomType
_ [Atom]
xs) = forall a. AttributeName -> [AtomExprBase a] -> a -> AtomExprBase a
ConstructedAtomExpr AttributeName
n (Atom -> AtomExprBase ()
toAtomExpr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Atom]
xs) () 
toAtomExpr Atom
a = forall a. Atom -> AtomExprBase a
NakedAtomExpr Atom
a