module Language.Drasil.Code.Imperative.FunctionCalls (
  genAllInputCalls, genAllInputCallsProc, genInputCall, genInputCallProc,
  genDerivedCall, genDerivedCallProc, genConstraintCall, genConstraintCallProc,
  genCalcCall, genCalcCallProc, genOutputCall, genOutputCallProc
) where

import Data.List ((\\), intersect)
import qualified Data.Map as Map (lookup)
import Data.Maybe (catMaybes)
import Control.Applicative ((<|>))
import Control.Monad.State (get)

import Drasil.Code.CodeVar (CodeIdea(codeName), CodeVarChunk, quantvar)
import Language.Drasil.Code.Imperative.GenerateGOOL (fApp, fAppProc, fAppInOut,
  fAppInOutProc)
import Language.Drasil.Code.Imperative.Helpers (convScope)
import Language.Drasil.Code.Imperative.Import (codeType, mkVal, mkValProc,
  mkVar, mkVarProc)
import Language.Drasil.Code.Imperative.Parameters (getCalcParams,
  getConstraintParams, getDerivedIns, getDerivedOuts, getInputFormatIns,
  getInputFormatOuts, getOutputParams)
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..),
  genICName)
import Language.Drasil.Chunk.CodeDefinition (CodeDefinition)
import Language.Drasil.Mod (Name)
import Language.Drasil.Choices (InternalConcept(..))

import Drasil.GOOL (SValue, MS, VS, TypeSym(..), VariableValue(..),
  ValueStatement(valStmt), DeclStatement(..), convType, convTypeOO, TypeData,
  FuncAppStatement, TypeElim, VariableElim, Argument, Set, ValueExpression,
  Comparison, BooleanExpression, MathConstant, List, SelfSym, OOFuncAppStatement,
  InternalValueExp, Literal, OOValueExpression)
import Drasil.GProc (NativeVector, Reference, NumericExpression)

-- | Generates calls to all of the input-related functions. First is the call to
-- the function for reading inputs, then the function for calculating derived
-- inputs, then the function for checking input constraints.
genAllInputCalls
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , OOFuncAppStatement r stmt
    , TypeElim r
    , VariableElim r
    )
  => GenState [MS (r stmt)]
genAllInputCalls :: forall (r :: * -> *) stmt.
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, ValueStatement r stmt, OOFuncAppStatement r stmt,
 TypeElim r, VariableElim r) =>
GenState [MS (r stmt)]
genAllInputCalls = do
  gi <- GenState (Maybe (MS (r stmt)))
forall (r :: * -> *) stmt.
(VariableValue r, SelfSym r, OOFuncAppStatement r stmt,
 VariableElim r) =>
GenState (Maybe (MS (r stmt)))
genInputCall
  dv <- genDerivedCall
  ic <- genConstraintCall
  return $ catMaybes [gi, dv, ic]

-- | Generates a call to the function for reading inputs from a file.
genInputCall
  :: (VariableValue r, SelfSym r, OOFuncAppStatement r stmt, VariableElim r)
  => GenState (Maybe (MS (r stmt)))
genInputCall :: forall (r :: * -> *) stmt.
(VariableValue r, SelfSym r, OOFuncAppStatement r stmt,
 VariableElim r) =>
GenState (Maybe (MS (r stmt)))
genInputCall = do
  giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  genInOutCall giName getInputFormatIns getInputFormatOuts

-- | Generates a call to the function for calculating derived inputs.
genDerivedCall
  :: (VariableValue r, SelfSym r, OOFuncAppStatement r stmt, VariableElim r)
  => GenState (Maybe (MS (r stmt)))
genDerivedCall :: forall (r :: * -> *) stmt.
(VariableValue r, SelfSym r, OOFuncAppStatement r stmt,
 VariableElim r) =>
GenState (Maybe (MS (r stmt)))
genDerivedCall = do
  dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  genInOutCall dvName getDerivedIns getDerivedOuts

-- | Generates a call to the function for checking constraints on the input.
genConstraintCall
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , TypeElim r
    , VariableElim r
    )
  => GenState (Maybe (MS (r stmt)))
genConstraintCall :: forall (r :: * -> *) stmt.
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, ValueStatement r stmt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r stmt)))
genConstraintCall = do
  icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  val <- genFuncCall icName void getConstraintParams
  return $ fmap valStmt val

-- | Generates a call to a calculation function, given the 'CodeDefinition' for the
-- value being calculated.
genCalcCall
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , DeclStatement r stmt bod
    , TypeElim r
    , VariableElim r
    )
  => CodeDefinition -> GenState (Maybe (MS (r stmt)))
genCalcCall :: forall (r :: * -> *) stmt bod.
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, DeclStatement r stmt bod, TypeElim r, VariableElim r) =>
CodeDefinition -> GenState (Maybe (MS (r stmt)))
genCalcCall CodeDefinition
c = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  t <- codeType c
  val <- genFuncCall (codeName c) (convTypeOO t) (getCalcParams c)
  v <- mkVar (quantvar c)
  return $ fmap (varDecDef v scp) val

-- | Generates a call to the function for printing outputs.
genOutputCall
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , TypeElim r
    , VariableElim r
    )
  => GenState (Maybe (MS (r stmt)))
genOutputCall :: forall (r :: * -> *) stmt.
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, ValueStatement r stmt, TypeElim r, VariableElim r) =>
GenState (Maybe (MS (r stmt)))
genOutputCall = do
  woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
  val <- genFuncCall woName void getOutputParams
  return $ fmap valStmt val

-- | Generates a function call given the name, return type, and arguments to
-- the function.
genFuncCall
  ::
    ( Argument r
    , Literal r
    , MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , SelfSym r
    , InternalValueExp r
    , OOValueExpression r
    , List r
    , Reference r
    , Set r
    , TypeElim r
    , VariableElim r
    )
  => Name
  -> VS (r TypeData)
  -> GenState [CodeVarChunk]
  -> GenState (Maybe (SValue r))
genFuncCall :: forall (r :: * -> *).
(Argument r, Literal r, MathConstant r, VariableValue r,
 BooleanExpression r, Comparison r, NumericExpression r, SelfSym r,
 InternalValueExp r, OOValueExpression r, List r, Reference r,
 Set r, TypeElim r, VariableElim r) =>
String
-> VS (r TypeData)
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
genFuncCall String
n VS (r TypeData)
t GenState [CodeVarChunk]
funcPs = do
  mm <- String -> GenState (Maybe String)
genCall String
n
  let genFuncCall' Maybe String
Nothing = Maybe (SValue r) -> StateT DrasilState Identity (Maybe (SValue r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SValue r)
forall a. Maybe a
Nothing
      genFuncCall' (Just String
m) = do
        cs <- GenState [CodeVarChunk]
funcPs
        pvals <- mapM mkVal cs
        val <- fApp m n t pvals []
        return $ Just val
  genFuncCall' mm

-- | Generates a function call given the name, inputs, and outputs for the
-- function.
genInOutCall
  :: (VariableValue r, SelfSym r, OOFuncAppStatement r stmt, VariableElim r)
  => Name
  -> GenState [CodeVarChunk]
  -> GenState [CodeVarChunk]
  -> GenState (Maybe (MS (r stmt)))
genInOutCall :: forall (r :: * -> *) stmt.
(VariableValue r, SelfSym r, OOFuncAppStatement r stmt,
 VariableElim r) =>
String
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MS (r stmt)))
genInOutCall String
n GenState [CodeVarChunk]
inFunc GenState [CodeVarChunk]
outFunc = do
  mm <- String -> GenState (Maybe String)
genCall String
n
  let genInOutCall' Maybe String
Nothing = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      genInOutCall' (Just String
m) = do
        ins' <- GenState [CodeVarChunk]
inFunc
        outs' <- outFunc
        ins <- mapM mkVar (ins' \\ outs')
        outs <- mapM mkVar (outs' \\ ins')
        both <- mapM mkVar (ins' `intersect` outs')
        stmt <- fAppInOut m n (map valueOf ins) outs both
        return $ Just stmt
  genInOutCall' mm

-- | Gets the name of the module containing the function being called.
-- If the function is not in either the module export map or class definition map,
--   return 'Nothing'.
-- If the function is not in module export map but is in the class definition map,
-- that means it is a private function, so return 'Nothing' unless it is in the
-- current class.
genCall :: Name -> GenState (Maybe Name)
genCall :: String -> GenState (Maybe String)
genCall String
n = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let currc = DrasilState -> String
currentClass DrasilState
g
      genCallExported Maybe String
Nothing = Maybe String -> GenState (Maybe String)
genCallInClass (String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
n (Map String String -> Maybe String)
-> Map String String -> Maybe String
forall a b. (a -> b) -> a -> b
$ DrasilState -> Map String String
clsMap DrasilState
g)
      genCallExported Maybe String
m = Maybe String -> GenState (Maybe String)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
m
      genCallInClass Maybe String
Nothing = Maybe String -> GenState (Maybe String)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
      genCallInClass (Just String
c) = if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
currc then Maybe String -> GenState (Maybe String)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> GenState (Maybe String))
-> Maybe String -> GenState (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
c (DrasilState -> Map String String
eMap
        DrasilState
g) Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
forall a. HasCallStack => String -> a
error (String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" class missing from export map")
        else Maybe String -> GenState (Maybe String)
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
  genCallExported $ Map.lookup n (eMap g)

-- Procedural Versions --

-- | Generates calls to all of the input-related functions. First is the call to
-- the function for reading inputs, then the function for calculating derived
-- inputs, then the function for checking input constraints.
genAllInputCallsProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , NativeVector r
    , FuncAppStatement r stmt
    , Argument r
    , List r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , TypeElim r
    )
  => GenState [MS (r stmt)]
genAllInputCallsProc :: forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r,
 NativeVector r, FuncAppStatement r stmt, Argument r, List r,
 Reference r, Set r, ValueStatement r stmt, TypeElim r) =>
GenState [MS (r stmt)]
genAllInputCallsProc = do
  gi <- GenState (Maybe (MS (r stmt)))
forall (r :: * -> *) stmt.
(FuncAppStatement r stmt, VariableValue r) =>
GenState (Maybe (MS (r stmt)))
genInputCallProc
  dv <- genDerivedCallProc
  ic <- genConstraintCallProc
  return $ catMaybes [gi, dv, ic]

-- | Generates a call to the function for reading inputs from a file.
genInputCallProc
  :: (FuncAppStatement r stmt, VariableValue r)
  => GenState (Maybe (MS (r stmt)))
genInputCallProc :: forall (r :: * -> *) stmt.
(FuncAppStatement r stmt, VariableValue r) =>
GenState (Maybe (MS (r stmt)))
genInputCallProc = do
  giName <- InternalConcept -> GenState String
genICName InternalConcept
GetInput
  genInOutCallProc giName getInputFormatIns getInputFormatOuts

-- | Generates a call to the function for calculating derived inputs.
genDerivedCallProc
  :: (FuncAppStatement r stmt, VariableValue r) => GenState (Maybe (MS (r stmt)))
genDerivedCallProc :: forall (r :: * -> *) stmt.
(FuncAppStatement r stmt, VariableValue r) =>
GenState (Maybe (MS (r stmt)))
genDerivedCallProc = do
  dvName <- InternalConcept -> GenState String
genICName InternalConcept
DerivedValuesFn
  genInOutCallProc dvName getDerivedIns getDerivedOuts

-- | Generates a call to the function for checking constraints on the input.
genConstraintCallProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , NativeVector r
    , Argument r
    , List r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , TypeElim r
    )
  => GenState (Maybe (MS (r stmt)))
genConstraintCallProc :: forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r,
 NativeVector r, Argument r, List r, Reference r, Set r,
 ValueStatement r stmt, TypeElim r) =>
GenState (Maybe (MS (r stmt)))
genConstraintCallProc = do
  icName <- InternalConcept -> GenState String
genICName InternalConcept
InputConstraintsFn
  val <- genFuncCallProc icName void getConstraintParams
  return $ fmap valStmt val

-- | Generates a call to a calculation function, given the 'CodeDefinition' for the
-- value being calculated.
genCalcCallProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , DeclStatement r stmt bod
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , Set r
    , TypeElim r
    )
  => CodeDefinition -> GenState (Maybe (MS (r stmt)))
genCalcCallProc :: forall (r :: * -> *) stmt bod.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r,
 DeclStatement r stmt bod, Argument r, List r, NativeVector r,
 Reference r, Set r, TypeElim r) =>
CodeDefinition -> GenState (Maybe (MS (r stmt)))
genCalcCallProc CodeDefinition
c = do
  g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let scp = ScopeType -> r ScopeData
forall (r :: * -> *). ScopeSym r => ScopeType -> r ScopeData
convScope (ScopeType -> r ScopeData) -> ScopeType -> r ScopeData
forall a b. (a -> b) -> a -> b
$ DrasilState -> ScopeType
currentScope DrasilState
g
  t <- codeType c
  val <- genFuncCallProc (codeName c) (convType t) (getCalcParams c)
  v <- mkVarProc (quantvar c)
  return $ fmap ((`varDecDef` scp) v) val

-- | Generates a call to the function for printing outputs.
genOutputCallProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , Set r
    , ValueStatement r stmt
    , TypeElim r
    )
  => GenState (Maybe (MS (r stmt)))
genOutputCallProc :: forall (r :: * -> *) stmt.
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 List r, NativeVector r, Reference r, Set r, ValueStatement r stmt,
 TypeElim r) =>
GenState (Maybe (MS (r stmt)))
genOutputCallProc = do
  woName <- InternalConcept -> GenState String
genICName InternalConcept
WriteOutput
  val <- genFuncCallProc woName void getOutputParams
  return $ fmap valStmt val

-- | Generates a function call given the name, return type, and arguments to
-- the function.
genFuncCallProc
  ::
    ( MathConstant r
    , VariableValue r
    , BooleanExpression r
    , Comparison r
    , NumericExpression r
    , ValueExpression r
    , Argument r
    , List r
    , NativeVector r
    , Reference r
    , Set r
    , TypeElim r
    )
  => Name
  -> VS (r TypeData)
  -> GenState [CodeVarChunk]
  -> GenState (Maybe (SValue r))
genFuncCallProc :: forall (r :: * -> *).
(MathConstant r, VariableValue r, BooleanExpression r,
 Comparison r, NumericExpression r, ValueExpression r, Argument r,
 List r, NativeVector r, Reference r, Set r, TypeElim r) =>
String
-> VS (r TypeData)
-> GenState [CodeVarChunk]
-> GenState (Maybe (SValue r))
genFuncCallProc String
n VS (r TypeData)
t GenState [CodeVarChunk]
funcPs = do
  mm <- String -> GenState (Maybe String)
genCall String
n
  let genFuncCall' Maybe String
Nothing = Maybe (SValue r) -> StateT DrasilState Identity (Maybe (SValue r))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SValue r)
forall a. Maybe a
Nothing
      genFuncCall' (Just String
m) = do
        cs <- GenState [CodeVarChunk]
funcPs
        pvals <- mapM mkValProc cs
        val <- fAppProc m n t pvals []
        return $ Just val
  genFuncCall' mm

-- | Generates a function call given the name, inputs, and outputs for the
-- function.
genInOutCallProc
  :: (FuncAppStatement r stmt, VariableValue r)
  => Name
  -> GenState [CodeVarChunk]
  -> GenState [CodeVarChunk]
  -> GenState (Maybe (MS (r stmt)))
genInOutCallProc :: forall (r :: * -> *) stmt.
(FuncAppStatement r stmt, VariableValue r) =>
String
-> GenState [CodeVarChunk]
-> GenState [CodeVarChunk]
-> GenState (Maybe (MS (r stmt)))
genInOutCallProc String
n GenState [CodeVarChunk]
inFunc GenState [CodeVarChunk]
outFunc = do
  mm <- String -> GenState (Maybe String)
genCall String
n
  let genInOutCall' Maybe String
Nothing = Maybe (MS (r stmt))
-> StateT DrasilState Identity (Maybe (MS (r stmt)))
forall a. a -> StateT DrasilState Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (MS (r stmt))
forall a. Maybe a
Nothing
      genInOutCall' (Just String
m) = do
        ins' <- GenState [CodeVarChunk]
inFunc
        outs' <- outFunc
        ins <- mapM mkVarProc (ins' \\ outs')
        outs <- mapM mkVarProc (outs' \\ ins')
        both <- mapM mkVarProc (ins' `intersect` outs')
        stmt <- fAppInOutProc m n (map valueOf ins) outs both
        return $ Just stmt
  genInOutCall' mm