module Language.Drasil.Code.Expr.Class where

import Language.Drasil (Callable, IsArgumentName, HasSpace(..),
  Space(..), HasUID(..))
import Language.Drasil.Chunk.CodeBase (CodeIdea, CodeVarChunk)
import Language.Drasil.Code.Expr (CodeExpr(Field, New, Message))

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)
  message :: (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


instance CodeExprC CodeExpr where
  new :: f -> [CodeExpr] -> CodeExpr
new c :: f
c ps :: [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 => Lens' c UID
uid) [CodeExpr]
ps []
  
  newWithNamedArgs :: f -> [CodeExpr] -> [(a, CodeExpr)] -> CodeExpr
newWithNamedArgs c :: f
c ps :: [CodeExpr]
ps ns :: [(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 => Lens' c 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 => Lens' c 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))

  message :: c -> f -> [CodeExpr] -> CodeExpr
message o :: c
o m :: f
m ps :: [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 => Lens' c Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor _) = 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 => Lens' 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 => Lens' c UID
uid) [CodeExpr]
ps []
          checkObj _ = [Char] -> CodeExpr
forall a. HasCallStack => [Char] -> a
error ([Char] -> CodeExpr) -> [Char] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ "Invalid actor message: Actor should have " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
            "Actor space"

  msgWithNamedArgs :: c -> f -> [CodeExpr] -> [(a, CodeExpr)] -> CodeExpr
msgWithNamedArgs o :: c
o m :: f
m ps :: [CodeExpr]
ps as :: [(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 => Lens' c Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor _) = 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 => Lens' 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 => Lens' c 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 => Lens' c 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 _ = [Char] -> CodeExpr
forall a. HasCallStack => [Char] -> a
error ([Char] -> CodeExpr) -> [Char] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ "Invalid actor message: Actor should have " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ 
            "Actor space"

  field :: CodeVarChunk -> CodeVarChunk -> CodeExpr
field o :: CodeVarChunk
o f :: 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 => Lens' c Space
typ)
    where checkObj :: Space -> CodeExpr
checkObj (Actor _) = 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 => Lens' c 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 => Lens' c UID
uid)
          checkObj _ = [Char] -> CodeExpr
forall a. HasCallStack => [Char] -> a
error ([Char] -> CodeExpr) -> [Char] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ "Invalid actor field: Actor should have " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
            "Actor space"