-- | Extract UIDs from an expression so that they can be looked up in the chunk database and rendered.
module Language.Drasil.Expr.Extract where

import Data.Containers.ListUtils (nubOrd)

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

-- | Generic traverse of all expressions that could lead to names.
eNames :: Expr -> [UID]
eNames :: Expr -> [UID]
eNames (AssocA AssocArithOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames [Expr]
l
eNames (AssocB AssocBoolOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames [Expr]
l
eNames (AssocC AssocConcatOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames [Expr]
l
eNames (C UID
c)                 = [UID
c]
eNames Lit{}                 = []
eNames (FCall UID
f [Expr]
x)           = UID
f UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames [Expr]
x
eNames (Case Completeness
_ [(Expr, Expr)]
ls)           = ((Expr, Expr) -> [UID]) -> [(Expr, Expr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Expr -> [UID]
eNames (Expr -> [UID]) -> ((Expr, Expr) -> Expr) -> (Expr, Expr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Expr) -> Expr
forall a b. (a, b) -> a
fst) [(Expr, Expr)]
ls [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++
                               ((Expr, Expr) -> [UID]) -> [(Expr, Expr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Expr -> [UID]
eNames (Expr -> [UID]) -> ((Expr, Expr) -> Expr) -> (Expr, Expr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Expr) -> Expr
forall a b. (a, b) -> b
snd) [(Expr, Expr)]
ls
eNames (UnaryOp UFunc
_ Expr
u)         = Expr -> [UID]
eNames Expr
u
eNames (UnaryOpB UFuncB
_ Expr
u)        = Expr -> [UID]
eNames Expr
u
eNames (UnaryOpVV UFuncVV
_ Expr
u)       = Expr -> [UID]
eNames Expr
u
eNames (UnaryOpVN UFuncVN
_ Expr
u)       = Expr -> [UID]
eNames Expr
u
eNames (ArithBinaryOp ArithBinOp
_ Expr
a Expr
b) = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (BoolBinaryOp BoolBinOp
_ Expr
a Expr
b)  = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (EqBinaryOp EqBinOp
_ Expr
a Expr
b)    = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (LABinaryOp LABinOp
_ Expr
a Expr
b)    = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (OrdBinaryOp OrdBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (VVVBinaryOp VVVBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (VVNBinaryOp VVNBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (NVVBinaryOp NVVBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames Expr
b
eNames (ESSBinaryOp ESSBinOp
_ Expr
_ Expr
s)   = Expr -> [UID]
eNames Expr
s
eNames (ESBBinaryOp ESBBinOp
_ Expr
_ Expr
s)   = Expr -> [UID]
eNames Expr
s
eNames (Operator AssocArithOper
_ DiscreteDomainDesc Expr Expr
_ Expr
e)      = Expr -> [UID]
eNames Expr
e
eNames (Matrix [[Expr]]
a)            = ([Expr] -> [UID]) -> [[Expr]] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames) [[Expr]]
a
eNames (Set Space
_ [Expr]
a)             = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames [Expr]
a
eNames (Variable String
_ Expr
e)        = Expr -> [UID]
eNames Expr
e
eNames (RealI UID
c RealInterval Expr Expr
b)           = UID
c UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: RealInterval Expr Expr -> [UID]
eNamesRI RealInterval Expr Expr
b

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

-- | Generic traverse of all positions that could lead to 'eNames' without
-- functions.  FIXME : this should really be done via post-facto filtering, but
-- right now the information needed to do this is not available!
eNames' :: Expr -> [UID]
eNames' :: Expr -> [UID]
eNames' (AssocA AssocArithOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames' [Expr]
l
eNames' (AssocB AssocBoolOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames' [Expr]
l
eNames' (AssocC AssocConcatOper
_ [Expr]
l)          = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames' [Expr]
l
eNames' (C UID
c)                 = [UID
c]
eNames' Lit{}                 = []
eNames' (FCall UID
_ [Expr]
x)           = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames' [Expr]
x
eNames' (Case Completeness
_ [(Expr, Expr)]
ls)           = ((Expr, Expr) -> [UID]) -> [(Expr, Expr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Expr -> [UID]
eNames' (Expr -> [UID]) -> ((Expr, Expr) -> Expr) -> (Expr, Expr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Expr) -> Expr
forall a b. (a, b) -> a
fst) [(Expr, Expr)]
ls [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ 
                                ((Expr, Expr) -> [UID]) -> [(Expr, Expr)] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Expr -> [UID]
eNames' (Expr -> [UID]) -> ((Expr, Expr) -> Expr) -> (Expr, Expr) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr, Expr) -> Expr
forall a b. (a, b) -> b
snd) [(Expr, Expr)]
ls
eNames' (UnaryOp UFunc
_ Expr
u)         = Expr -> [UID]
eNames' Expr
u
eNames' (UnaryOpB UFuncB
_ Expr
u)        = Expr -> [UID]
eNames' Expr
u
eNames' (UnaryOpVV UFuncVV
_ Expr
u)       = Expr -> [UID]
eNames' Expr
u
eNames' (UnaryOpVN UFuncVN
_ Expr
u)       = Expr -> [UID]
eNames' Expr
u
eNames' (ArithBinaryOp ArithBinOp
_ Expr
a Expr
b) = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (BoolBinaryOp BoolBinOp
_ Expr
a Expr
b)  = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (EqBinaryOp EqBinOp
_ Expr
a Expr
b)    = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (LABinaryOp LABinOp
_ Expr
a Expr
b)    = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (OrdBinaryOp OrdBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (VVVBinaryOp VVVBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (VVNBinaryOp VVNBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (NVVBinaryOp NVVBinOp
_ Expr
a Expr
b)   = Expr -> [UID]
eNames' Expr
a [UID] -> [UID] -> [UID]
forall a. [a] -> [a] -> [a]
++ Expr -> [UID]
eNames' Expr
b
eNames' (ESSBinaryOp ESSBinOp
_ Expr
_ Expr
s)   = Expr -> [UID]
eNames' Expr
s
eNames' (ESBBinaryOp ESBBinOp
_ Expr
_ Expr
s)   = Expr -> [UID]
eNames' Expr
s
eNames' (Operator AssocArithOper
_ DiscreteDomainDesc Expr Expr
_ Expr
e)      = Expr -> [UID]
eNames' Expr
e
eNames' (Matrix [[Expr]]
a)            = ([Expr] -> [UID]) -> [[Expr]] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames') [[Expr]]
a
eNames' (Set Space
_ [Expr]
a)             = (Expr -> [UID]) -> [Expr] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Expr -> [UID]
eNames' [Expr]
a
eNames' (Variable String
_ Expr
e)        = Expr -> [UID]
eNames' Expr
e
eNames' (RealI UID
c RealInterval Expr Expr
b)           = UID
c UID -> [UID] -> [UID]
forall a. a -> [a] -> [a]
: RealInterval Expr Expr -> [UID]
eNamesRI' RealInterval Expr Expr
b

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

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

-- | Get dependencies from an equation.  
eDep :: Expr -> [UID]
eDep :: Expr -> [UID]
eDep = [UID] -> [UID]
forall a. Ord a => [a] -> [a]
nubOrd ([UID] -> [UID]) -> (Expr -> [UID]) -> Expr -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> [UID]
eNames