-- | 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.List (nub)

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