-- | Defines functions to find Chunk UIDs within 'ModelExpr's.
module Language.Drasil.ModelExpr.Extract where

import Data.List (nub)

import Language.Drasil.ModelExpr.Lang (ModelExpr(..))
import Language.Drasil.Space (RealInterval(..))
import Language.Drasil.UID (UID)

-- | Generic traverse of all expressions that could lead to names.
meNames :: ModelExpr -> [UID]
meNames :: ModelExpr -> [UID]
meNames (AssocA AssocArithOper
_ [ModelExpr]
l)          = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
l
meNames (AssocB AssocBoolOper
_ [ModelExpr]
l)          = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
l
meNames (Deriv Integer
_ DerivType
_ ModelExpr
a UID
b)       = UID
b forall a. a -> [a] -> [a]
: ModelExpr -> [UID]
meNames ModelExpr
a
meNames (C UID
c)                 = [UID
c]
meNames Lit{}                 = []
meNames Spc{}                 = []
meNames (FCall UID
f [ModelExpr]
x)           = UID
f forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
x
meNames (Case Completeness
_ [(ModelExpr, ModelExpr)]
ls)           = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ModelExpr, ModelExpr)]
ls forall a. [a] -> [a] -> [a]
++
                                forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ModelExpr, ModelExpr)]
ls
meNames (UnaryOp UFunc
_ ModelExpr
u)         = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpB UFuncB
_ ModelExpr
u)        = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpVV UFuncVV
_ ModelExpr
u)       = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpVN UFuncVN
_ ModelExpr
u)       = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (ArithBinaryOp ArithBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (BoolBinaryOp BoolBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (EqBinaryOp EqBinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (LABinaryOp LABinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (SpaceBinaryOp SpaceBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (StatBinaryOp StatBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (OrdBinaryOp OrdBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVVBinaryOp VVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVNBinaryOp VVNBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (NVVBinaryOp NVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (Operator AssocArithOper
_ DomainDesc t ModelExpr ModelExpr
_ ModelExpr
e)      = ModelExpr -> [UID]
meNames ModelExpr
e
meNames (Matrix [[ModelExpr]]
a)            = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames) [[ModelExpr]]
a
meNames (RealI UID
c RealInterval ModelExpr ModelExpr
b)           = UID
c forall a. a -> [a] -> [a]
: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI RealInterval ModelExpr ModelExpr
b
meNames (ForAll UID
_ Space
_ ModelExpr
de)       = ModelExpr -> [UID]
meNames ModelExpr
de

-- | Generic traversal of everything that could come from an interval to names (similar to 'meNames').
meNamesRI :: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI :: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI (Bounded (Inclusive
_, ModelExpr
il) (Inclusive
_, ModelExpr
iu)) = ModelExpr -> [UID]
meNames ModelExpr
il forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
iu
meNamesRI (UpTo (Inclusive
_, ModelExpr
iu))            = ModelExpr -> [UID]
meNames ModelExpr
iu
meNamesRI (UpFrom (Inclusive
_, ModelExpr
il))          = ModelExpr -> [UID]
meNames ModelExpr
il

-- | Generic traverse of all positions that could lead to 'meNames' without
-- functions.  FIXME : this should really be done via post-facto filtering, but
-- right now the information needed to do this is not available!
meNames' :: ModelExpr -> [UID]
meNames' :: ModelExpr -> [UID]
meNames' (AssocA AssocArithOper
_ [ModelExpr]
l)          = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
l
meNames' (AssocB AssocBoolOper
_ [ModelExpr]
l)          = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
l
meNames' (Deriv Integer
_ DerivType
_ ModelExpr
a UID
b)       = UID
b forall a. a -> [a] -> [a]
: ModelExpr -> [UID]
meNames' ModelExpr
a
meNames' (C UID
c)                 = [UID
c]
meNames' Lit{}                 = []
meNames' Spc{}                 = []
meNames' (FCall UID
_ [ModelExpr]
x)           = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
x
meNames' (Case Completeness
_ [(ModelExpr, ModelExpr)]
ls)           = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(ModelExpr, ModelExpr)]
ls forall a. [a] -> [a] -> [a]
++ 
                                 forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(ModelExpr, ModelExpr)]
ls
meNames' (UnaryOp UFunc
_ ModelExpr
u)         = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpB UFuncB
_ ModelExpr
u)        = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpVV UFuncVV
_ ModelExpr
u)       = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpVN UFuncVN
_ ModelExpr
u)       = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (ArithBinaryOp ArithBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (BoolBinaryOp BoolBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (EqBinaryOp EqBinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (LABinaryOp LABinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (OrdBinaryOp OrdBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (SpaceBinaryOp SpaceBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (StatBinaryOp StatBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVVBinaryOp VVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVNBinaryOp VVNBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (NVVBinaryOp NVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (Operator AssocArithOper
_ DomainDesc t ModelExpr ModelExpr
_ ModelExpr
e)      = ModelExpr -> [UID]
meNames' ModelExpr
e
meNames' (Matrix [[ModelExpr]]
a)            = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames') [[ModelExpr]]
a
meNames' (RealI UID
c RealInterval ModelExpr ModelExpr
b)           = UID
c forall a. a -> [a] -> [a]
: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI' RealInterval ModelExpr ModelExpr
b
meNames' (ForAll UID
_ Space
_ ModelExpr
de)       = ModelExpr -> [UID]
meNames' ModelExpr
de

-- | Generic traversal of everything that could come from an interval to names without functions (similar to 'meNames'').
meNamesRI' :: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI' :: RealInterval ModelExpr ModelExpr -> [UID]
meNamesRI' (Bounded (Inclusive, ModelExpr)
il (Inclusive, ModelExpr)
iu) = ModelExpr -> [UID]
meNames' (forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
il) forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' (forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
iu)
meNamesRI' (UpTo (Inclusive, ModelExpr)
iu)       = ModelExpr -> [UID]
meNames' (forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
iu)
meNamesRI' (UpFrom (Inclusive, ModelExpr)
il)     = ModelExpr -> [UID]
meNames' (forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
il)

---------------------------------------------------------------------------
-- And now implement the exported traversals all in terms of the above

-- | Get dependencies from an equation.  
meDep :: ModelExpr -> [UID]
meDep :: ModelExpr -> [UID]
meDep = forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelExpr -> [UID]
meNames