-- | Extract UIDs from an expression so that they can be looked up in the chunk database and rendered.
module Language.Drasil.Expr.Extract (
  eDep, eNames, eNames', eNamesRI
) where

import Data.Containers.ListUtils (nubOrd)

import Drasil.Database (UID)

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

-- | 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 (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' (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