content: {-# 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 = AttributeNames . S.fromList 
    toList (AttributeNames ns) = S.toList ns
    toList _ = error "needs AttributeNames"
  
  instance IsList (TupleExprsBase ()) where
    type Item TupleExprs = TupleExpr
    fromList = TupleExprs ()
    toList (TupleExprs _ ts) = ts
  
  instance IsList TupleExpr where
    type Item TupleExpr = (AttributeName, AtomExpr) 
    fromList attributeValues = TupleExpr (M.fromList attributeValues)
    toList (TupleExpr attributeValues) = M.toList attributeValues
  
  
  -- #xxx :: Text
  instance KnownSymbol x => IsLabel x Text where
    fromLabel = T.pack $ symbolVal @x Proxy
  
  -- #relvarName :: RelationalExpr
  instance KnownSymbol x => IsLabel x RelationalExpr where
    fromLabel = RelationVariable (T.pack $ symbolVal @x 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 = (NakedAttributeExpr . Attribute name) . toAtomType''
      where name = T.pack $ symbolVal @x Proxy
  
  -- (#a 1) :: ExtendTupleExpr
  -- no need for :=
  instance (Convertible a AtomExpr, KnownSymbol x) => IsLabel x (a -> ExtendTupleExpr) where
    fromLabel x = AttributeExtendTupleExpr name (convert x) 
      where name = T.pack $ symbolVal @x 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 = \x -> (name, convert x)
      where name = T.pack $ symbolVal @x 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 = \as' -> FunctionAtomExpr name (map convert as') ()
      where name = T.pack $ symbolVal @x Proxy
  
  instance (KnownSymbol x) => IsLabel x AtomExpr where
    fromLabel = AttributeAtomExpr name
      where name = T.pack $ symbolVal @x 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'' (_ :: HaskAtomType a) = toAtomType (Proxy @a)
  
  -- usage: relation [tuple [#a 1, #b "b"], tuple [#a 2, #b "b"]]
  relation :: [TupleExpr] -> RelationalExpr
  relation ts = MakeRelationFromExprs Nothing (TupleExprs () ts)
  
  relation' :: [AttributeExprBase ()] -> [TupleExpr] -> RelationalExpr
  relation' as' ts = MakeRelationFromExprs (Just as') (TupleExprs () ts)
  
  -- usage: tuple [#name "Mike",#age 6]
  tuple :: [(AttributeName, AtomExpr)] -> TupleExprBase ()
  tuple as' = TupleExpr (M.fromList as')
  
  -- #a rename  [#b `as` #c]
  rename :: RelationalExpr -> [(AttributeName,AttributeName)] -> RelationalExpr 
  rename relExpr renameList = case renameList of 
    [] -> Restrict TruePredicate relExpr
    renames -> Rename (S.fromList renames) relExpr
  
  --project !!
  -- #a !! [#b,#c]
  infix 9 !!
  (!!) :: RelationalExpr -> AttributeNames -> RelationalExpr  
  relExpr !! xs = Project xs relExpr
  
  --join ><
  -- #a >< #b
  (><) :: RelationalExpr -> RelationalExpr -> RelationalExpr
  a >< b = Join a b
  
  allBut :: AttributeNames -> AttributeNames
  allBut (AttributeNames ns) = InvertedAttributeNames ns
  allBut _ = error "give allBut something other than attribute names."
  
  allFrom :: RelationalExpr -> AttributeNames
  allFrom = RelationalExprAttributeNames 
  
  as :: AttributeNames -> AttributeName -> (AttributeNames, AttributeName)
  as = (,)
  
  -- #a `group` ([#b,#c] `as` #d)
  group :: RelationalExpr -> (AttributeNames, AttributeName) -> RelationalExpr
  group relExpr (aNames, aName) = Group aNames aName relExpr
  
  -- #a `ungroup` #b
  ungroup :: RelationalExpr -> AttributeName -> RelationalExpr
  ungroup relExpr aName = Ungroup aName 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
  a #: b = Extend b a
  infix 8 #:
  
  instance Convertible AtomExpr AtomExpr where
    safeConvert = Right
  
  instance Convertible RelVarName AtomExpr where
    safeConvert n = Right $ RelationAtomExpr (RelationVariable n ()) 
  
  instance Convertible RelationalExpr AtomExpr where
    safeConvert relExpr = Right $ RelationAtomExpr relExpr
  
  instance Convertible RelVarName RelationalExpr where
    safeConvert n = Right $ RelationVariable n ()
  
  -- @ in tutd
  -- (@@) "aaa"
  (@@) :: AttributeName -> AtomExpr
  (@@) = AttributeAtomExpr 
  
  -- works in RestrictedPredicateExpr and AttributeExtendTupleExpr 
  -- usage: f "gte" [1]
  f :: Convertible a AtomExpr => FunctionName -> [a] -> AtomExpr
  f n as' = FunctionAtomExpr n (map convert as') ()
  
  -- DatabaseContextExpr
  -- define
  (#::) :: RelVarName -> [AttributeExpr] -> DatabaseContextExpr
  s #:: xs =  Define s xs
  infix 5 #::
  
  -- assign
  (#:=) :: RelVarName -> RelationalExpr -> DatabaseContextExpr 
  s #:= r = Assign s 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
  (@~) relExpr resPreExpr = Restrict (convert resPreExpr) relExpr
  infix 4 @~
  
  true :: RelationalExpr
  true = ExistingRelation relationTrue
  
  false :: RelationalExpr
  false = ExistingRelation relationFalse
  
  trueP :: RestrictionPredicateExprBase a
  trueP = TruePredicate
  
  falseP :: RestrictionPredicateExprBase a
  falseP = NotPredicate TruePredicate
  
  (?=) :: Convertible a AtomExpr => AttributeName -> a -> RestrictionPredicateExpr
  (?=) name a = AttributeEqualityPredicate name (convert a)
  infix 9 ?=
  
  not' :: Convertible a RestrictionPredicateExpr => a -> RestrictionPredicateExpr
  not' = NotPredicate . convert
  
  instance (Convertible a RestrictionPredicateExpr, Convertible b RestrictionPredicateExpr) => Boolean a b where
    a &&& b = AndPredicate (convert a) (convert b) 
    a ||| b = OrPredicate (convert a) (convert b)
  
  instance {-# Incoherent #-} Atomable a => Convertible a RestrictionPredicateExpr where
    safeConvert n = Right $ AtomExprPredicate $ toAtomExpr . toAtom $ n 
  
  instance {-# Incoherent #-} Convertible RelationalExpr RestrictionPredicateExpr where
    safeConvert a = Right $ RelationalExprPredicate a
   
  instance {-# Incoherent #-} Convertible AtomExpr RestrictionPredicateExpr where
    safeConvert a = Right $ AtomExprPredicate a
  
  instance {-# Incoherent #-} Convertible RestrictionPredicateExpr RestrictionPredicateExpr where
    safeConvert = Right
  
  instance {-# Incoherent #-} Atomable a => Convertible a AtomExpr where
    safeConvert n = Right $ toAtomExpr . toAtom $ n 
  
  toAtomExpr :: Atom -> AtomExpr
  toAtomExpr (ConstructedAtom n _ xs) = ConstructedAtomExpr n (toAtomExpr <$> xs) () 
  toAtomExpr a = NakedAtomExpr a
  
  
  
  