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

import Data.Containers.ListUtils (nubOrd)

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)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
l
meNames (AssocB AssocBoolOper
_ [ModelExpr]
l)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
l
meNames (AssocC AssocConcatOper
_ [ModelExpr]
l)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
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 UID -> [UID] -> [UID]
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 UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
x
meNames (Case Completeness
_ [(ModelExpr, ModelExpr)]
ls)           = ((ModelExpr, ModelExpr) -> [UID])
-> [(ModelExpr, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames (ModelExpr -> [UID])
-> ((ModelExpr, ModelExpr) -> ModelExpr)
-> (ModelExpr, ModelExpr)
-> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModelExpr, ModelExpr) -> ModelExpr
forall a b. (a, b) -> a
fst) [(ModelExpr, ModelExpr)]
ls [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++
                                ((ModelExpr, ModelExpr) -> [UID])
-> [(ModelExpr, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames (ModelExpr -> [UID])
-> ((ModelExpr, ModelExpr) -> ModelExpr)
-> (ModelExpr, ModelExpr)
-> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModelExpr, ModelExpr) -> ModelExpr
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 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (BoolBinaryOp BoolBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (EqBinaryOp EqBinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (LABinaryOp LABinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (SpaceBinaryOp SpaceBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (StatBinaryOp StatBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (OrdBinaryOp OrdBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVVBinaryOp VVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVNBinaryOp VVNBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (NVVBinaryOp NVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (ESSBinaryOp ESSBinOp
_ ModelExpr
_ ModelExpr
s)   = ModelExpr -> [UID]
meNames ModelExpr
s
meNames (ESBBinaryOp ESBBinOp
_ ModelExpr
_ ModelExpr
s)   = ModelExpr -> [UID]
meNames ModelExpr
s
meNames (Operator AssocArithOper
_ DomainDesc t ModelExpr ModelExpr
_ ModelExpr
e)      = ModelExpr -> [UID]
meNames ModelExpr
e
meNames (Matrix [[ModelExpr]]
a)            = ([ModelExpr] -> [UID]) -> [[ModelExpr]] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames) [[ModelExpr]]
a
meNames (Set Space
_ [ModelExpr]
a)             = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames [ModelExpr]
a
meNames (Variable String
_ ModelExpr
e)        = ModelExpr -> [UID]
meNames ModelExpr
e
meNames (RealI UID
c RealInterval ModelExpr ModelExpr
b)           = UID
c UID -> [UID] -> [UID]
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 [UID] -> [UID] -> [UID]
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)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
l
meNames' (AssocB AssocBoolOper
_ [ModelExpr]
l)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
l
meNames' (AssocC AssocConcatOper
_ [ModelExpr]
l)          = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
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 UID -> [UID] -> [UID]
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)           = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
x
meNames' (Case Completeness
_ [(ModelExpr, ModelExpr)]
ls)           = ((ModelExpr, ModelExpr) -> [UID])
-> [(ModelExpr, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames' (ModelExpr -> [UID])
-> ((ModelExpr, ModelExpr) -> ModelExpr)
-> (ModelExpr, ModelExpr)
-> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModelExpr, ModelExpr) -> ModelExpr
forall a b. (a, b) -> a
fst) [(ModelExpr, ModelExpr)]
ls [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ 
                                 ((ModelExpr, ModelExpr) -> [UID])
-> [(ModelExpr, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames' (ModelExpr -> [UID])
-> ((ModelExpr, ModelExpr) -> ModelExpr)
-> (ModelExpr, ModelExpr)
-> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModelExpr, ModelExpr) -> ModelExpr
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 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (BoolBinaryOp BoolBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (EqBinaryOp EqBinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (LABinaryOp LABinOp
_ ModelExpr
a ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (OrdBinaryOp OrdBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (SpaceBinaryOp SpaceBinOp
_ ModelExpr
a ModelExpr
b) = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (StatBinaryOp StatBinOp
_ ModelExpr
a ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVVBinaryOp VVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVNBinaryOp VVNBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (NVVBinaryOp NVVBinOp
_ ModelExpr
a ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (ESSBinaryOp ESSBinOp
_ ModelExpr
_ ModelExpr
s)   = ModelExpr -> [UID]
meNames' ModelExpr
s
meNames' (ESBBinaryOp ESBBinOp
_ ModelExpr
_ ModelExpr
s)   = ModelExpr -> [UID]
meNames' ModelExpr
s
meNames' (Operator AssocArithOper
_ DomainDesc t ModelExpr ModelExpr
_ ModelExpr
e)      = ModelExpr -> [UID]
meNames' ModelExpr
e
meNames' (Matrix [[ModelExpr]]
a)            = ([ModelExpr] -> [UID]) -> [[ModelExpr]] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames') [[ModelExpr]]
a
meNames' (Set Space
_ [ModelExpr]
a)             = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
a
meNames' (Variable String
_ ModelExpr
e)        = ModelExpr -> [UID]
meNames' ModelExpr
e
meNames' (RealI UID
c RealInterval ModelExpr ModelExpr
b)           = UID
c UID -> [UID] -> [UID]
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' ((Inclusive, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
il) [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ((Inclusive, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
iu)
meNamesRI' (UpTo (Inclusive, ModelExpr)
iu)       = ModelExpr -> [UID]
meNames' ((Inclusive, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
iu)
meNamesRI' (UpFrom (Inclusive, ModelExpr)
il)     = ModelExpr -> [UID]
meNames' ((Inclusive, ModelExpr) -> ModelExpr
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 = [UID] -> [UID]
forall a. Ord a => [a] -> [a]
nubOrd ([UID] -> [UID]) -> (ModelExpr -> [UID]) -> ModelExpr -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelExpr -> [UID]
meNames