module Language.Drasil.CodeExpr.Class where

import Language.Drasil.Classes(IsArgumentName, Callable)
import Language.Drasil.UID (HasUID(..))
import Language.Drasil.Symbol (HasSymbol)
import Language.Drasil.Space (Space(Actor), HasSpace(..))
import Language.Drasil.Chunk.CodeVar (CodeIdea, CodeVarChunk)
import Language.Drasil.Expr.Class (ExprC(..))
import Language.Drasil.CodeExpr.Lang (CodeExpr(FCall, New, Message, Field))

import Control.Lens ( (^.) )

class CodeExprC r where
  -- | Constructs a CodeExpr for actor creation (constructor call)
  new :: (Callable f, HasUID f, CodeIdea f) => f -> [r] -> r
  
  -- | Constructs a CodeExpr for actor creation (constructor call) that uses named arguments
  newWithNamedArgs :: (Callable f, HasUID f, CodeIdea f, HasUID a, 
    IsArgumentName a) => f -> [r] -> [(a, r)] -> r
  
  -- | Constructs a CodeExpr for actor messaging (method call)
  msg :: (Callable f, HasUID f, CodeIdea f, HasUID c, HasSpace c, CodeIdea c) 
    => c -> f -> [r] -> r
  
  -- | Constructs a CodeExpr for actor messaging (method call) that uses named arguments
  msgWithNamedArgs :: (Callable f, HasUID f, CodeIdea f, HasUID c, HasSpace c, 
    CodeIdea c, HasUID a, IsArgumentName a) => c -> f -> [r] -> [(a, r)] -> 
    r
  
  -- | Constructs a CodeExpr representing the field of an actor
  field :: CodeVarChunk -> CodeVarChunk -> r

  -- | Similar to 'apply', but takes a relation to apply to 'FCall'.
  applyWithNamedArgs :: (HasUID f, HasSymbol f, HasUID a, IsArgumentName a) => f 
    -> [r] -> [(a, r)] -> r

instance CodeExprC CodeExpr where
  new :: forall f.
(Callable f, HasUID f, CodeIdea f) =>
f -> [CodeExpr] -> CodeExpr
new f
c [CodeExpr]
ps = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
New (f
c f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps []
  
  newWithNamedArgs :: forall f a.
(Callable f, HasUID f, CodeIdea f, HasUID a, IsArgumentName a) =>
f -> [CodeExpr] -> [(a, CodeExpr)] -> CodeExpr
newWithNamedArgs f
c [CodeExpr]
ps [(a, CodeExpr)]
ns = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
New (f
c f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps ([UID] -> [CodeExpr] -> [(UID, CodeExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((a, CodeExpr) -> UID) -> [(a, CodeExpr)] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (a -> UID) -> ((a, CodeExpr) -> a) -> (a, CodeExpr) -> UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, CodeExpr) -> a
forall a b. (a, b) -> a
fst) [(a, CodeExpr)]
ns) 
    (((a, CodeExpr) -> CodeExpr) -> [(a, CodeExpr)] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map (a, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd [(a, CodeExpr)]
ns))

  msg :: forall f c.
(Callable f, HasUID f, CodeIdea f, HasUID c, HasSpace c,
 CodeIdea c) =>
c -> f -> [CodeExpr] -> CodeExpr
msg c
o f
m [CodeExpr]
ps = Space -> CodeExpr
checkObj (c
o c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor String
_) = UID -> UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
Message (c
o c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) (f
m f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps []
          checkObj Space
_ = String -> CodeExpr
forall a. HasCallStack => String -> a
error (String -> CodeExpr) -> String -> CodeExpr
forall a b. (a -> b) -> a -> b
$ String
"Invalid actor message: Actor should have " String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
            String
"Actor space"

  msgWithNamedArgs :: forall f c a.
(Callable f, HasUID f, CodeIdea f, HasUID c, HasSpace c,
 CodeIdea c, HasUID a, IsArgumentName a) =>
c -> f -> [CodeExpr] -> [(a, CodeExpr)] -> CodeExpr
msgWithNamedArgs c
o f
m [CodeExpr]
ps [(a, CodeExpr)]
as = Space -> CodeExpr
checkObj (c
o c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor String
_) = UID -> UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
Message (c
o c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) (f
m f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps 
            ([UID] -> [CodeExpr] -> [(UID, CodeExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((a, CodeExpr) -> UID) -> [(a, CodeExpr)] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (a -> UID) -> ((a, CodeExpr) -> a) -> (a, CodeExpr) -> UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, CodeExpr) -> a
forall a b. (a, b) -> a
fst) [(a, CodeExpr)]
as) (((a, CodeExpr) -> CodeExpr) -> [(a, CodeExpr)] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map (a, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd [(a, CodeExpr)]
as))
          checkObj Space
_ = String -> CodeExpr
forall a. HasCallStack => String -> a
error (String -> CodeExpr) -> String -> CodeExpr
forall a b. (a -> b) -> a -> b
$ String
"Invalid actor message: Actor should have " String -> String -> String
forall a. [a] -> [a] -> [a]
++ 
            String
"Actor space"

  field :: CodeVarChunk -> CodeVarChunk -> CodeExpr
field CodeVarChunk
o CodeVarChunk
f = Space -> CodeExpr
checkObj (CodeVarChunk
o CodeVarChunk -> Getting Space CodeVarChunk Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space CodeVarChunk Space
forall c. HasSpace c => Getter c Space
Getter CodeVarChunk Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor String
_) = UID -> UID -> CodeExpr
Field (CodeVarChunk
o CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid) (CodeVarChunk
f CodeVarChunk -> Getting UID CodeVarChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeVarChunk UID
forall c. HasUID c => Getter c UID
Getter CodeVarChunk UID
uid)
          checkObj Space
_ = String -> CodeExpr
forall a. HasCallStack => String -> a
error (String -> CodeExpr) -> String -> CodeExpr
forall a b. (a -> b) -> a -> b
$ String
"Invalid actor field: Actor should have " String -> String -> String
forall a. [a] -> [a] -> [a]
++
            String
"Actor space"
  
  -- | Similar to 'apply', but takes a relation to apply to 'FCall'.
  applyWithNamedArgs :: forall f a.
(HasUID f, HasSymbol f, HasUID a, IsArgumentName a) =>
f -> [CodeExpr] -> [(a, CodeExpr)] -> CodeExpr
applyWithNamedArgs f
f [] [] = f -> CodeExpr
forall c. (HasUID c, HasSymbol c) => c -> CodeExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy f
f
  applyWithNamedArgs f
f [CodeExpr]
ps [(a, CodeExpr)]
ns = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
FCall (f
f f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) [CodeExpr]
ps ([UID] -> [CodeExpr] -> [(UID, CodeExpr)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((a, CodeExpr) -> UID) -> [(a, CodeExpr)] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) (a -> UID) -> ((a, CodeExpr) -> a) -> (a, CodeExpr) -> UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, CodeExpr) -> a
forall a b. (a, b) -> a
fst) [(a, CodeExpr)]
ns) 
    (((a, CodeExpr) -> CodeExpr) -> [(a, CodeExpr)] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map (a, CodeExpr) -> CodeExpr
forall a b. (a, b) -> b
snd [(a, CodeExpr)]
ns))