-- | 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 _ l :: [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 _ l :: [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 _ _ a :: ModelExpr
a b :: UID
b)       = UID
b UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: ModelExpr -> [UID]
meNames ModelExpr
a
meNames (C c :: UID
c)                 = [UID
c]
meNames Lit{}                 = []
meNames Spc{}                 = []
meNames (FCall f :: UID
f x :: [ModelExpr]
x ns :: [(UID, ModelExpr)]
ns)        = 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 [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ((UID, ModelExpr) -> UID) -> [(UID, ModelExpr)] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (UID, ModelExpr) -> UID
forall a b. (a, b) -> a
fst [(UID, ModelExpr)]
ns [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ 
                              ((UID, ModelExpr) -> [UID]) -> [(UID, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames (ModelExpr -> [UID])
-> ((UID, ModelExpr) -> ModelExpr) -> (UID, ModelExpr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd) [(UID, ModelExpr)]
ns
meNames (Case _ ls :: [(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 _ u :: ModelExpr
u)         = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpB _ u :: ModelExpr
u)        = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpVV _ u :: ModelExpr
u)       = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (UnaryOpVN _ u :: ModelExpr
u)       = ModelExpr -> [UID]
meNames ModelExpr
u
meNames (ArithBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b) = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (BoolBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (EqBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (LABinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)    = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (SpaceBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b) = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (StatBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)  = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (OrdBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVVBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (VVNBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
b
meNames (Operator _ _ e :: ModelExpr
e)      = ModelExpr -> [UID]
meNames ModelExpr
e
meNames (Matrix a :: [[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 (RealI c :: UID
c b :: 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 _ _ de :: 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 (_, il :: ModelExpr
il) (_, iu :: ModelExpr
iu)) = ModelExpr -> [UID]
meNames ModelExpr
il [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames ModelExpr
iu
meNamesRI (UpTo (_, iu :: ModelExpr
iu))            = ModelExpr -> [UID]
meNames ModelExpr
iu
meNamesRI (UpFrom (_, il :: 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 _ l :: [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 _ l :: [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 _ _ a :: ModelExpr
a b :: UID
b)       = UID
b UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: ModelExpr -> [UID]
meNames' ModelExpr
a
meNames' (C c :: UID
c)                 = [UID
c]
meNames' Lit{}                 = []
meNames' Spc{}                 = []
meNames' (FCall _ x :: [ModelExpr]
x ns :: [(UID, ModelExpr)]
ns)        = (ModelExpr -> [UID]) -> [ModelExpr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ModelExpr -> [UID]
meNames' [ModelExpr]
x [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ((UID, ModelExpr) -> UID) -> [(UID, ModelExpr)] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (UID, ModelExpr) -> UID
forall a b. (a, b) -> a
fst [(UID, ModelExpr)]
ns [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ 
                               ((UID, ModelExpr) -> [UID]) -> [(UID, ModelExpr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ModelExpr -> [UID]
meNames (ModelExpr -> [UID])
-> ((UID, ModelExpr) -> ModelExpr) -> (UID, ModelExpr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UID, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd) [(UID, ModelExpr)]
ns
meNames' (Case _ ls :: [(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 _ u :: ModelExpr
u)         = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpB _ u :: ModelExpr
u)        = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpVV _ u :: ModelExpr
u)       = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (UnaryOpVN _ u :: ModelExpr
u)       = ModelExpr -> [UID]
meNames' ModelExpr
u
meNames' (ArithBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b) = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (BoolBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (EqBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (LABinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)    = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (OrdBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (SpaceBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b) = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (StatBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)  = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVVBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (VVNBinaryOp _ a :: ModelExpr
a b :: ModelExpr
b)   = ModelExpr -> [UID]
meNames' ModelExpr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ ModelExpr -> [UID]
meNames' ModelExpr
b
meNames' (Operator _ _ e :: ModelExpr
e)      = ModelExpr -> [UID]
meNames' ModelExpr
e
meNames' (Matrix a :: [[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' (RealI c :: UID
c b :: 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 _ _ de :: 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 il :: (Inclusive, ModelExpr)
il iu :: (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 iu :: (Inclusive, ModelExpr)
iu)       = ModelExpr -> [UID]
meNames' ((Inclusive, ModelExpr) -> ModelExpr
forall a b. (a, b) -> b
snd (Inclusive, ModelExpr)
iu)
meNamesRI' (UpFrom il :: (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. Eq a => [a] -> [a]
nub ([UID] -> [UID]) -> (ModelExpr -> [UID]) -> ModelExpr -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModelExpr -> [UID]
meNames