module Language.Drasil.Chunk.ConstraintMap (ConstraintCEMap, ConstraintCE,
constraintMap, physLookup, sfwrLookup
) where
import Control.Lens ((^.))
import Language.Drasil (Constraint, HasUID(..), UID, Constrained(..),
isPhysC, isSfwrC)
import Language.Drasil.Code.Expr.Development (CodeExpr, constraint)
import qualified Data.Map as Map
type ConstraintCE = Constraint CodeExpr
type ConstraintCEMap = Map.Map UID [ConstraintCE]
constraintMap :: (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap :: [c] -> ConstraintCEMap
constraintMap = [(UID, [Constraint CodeExpr])] -> ConstraintCEMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(UID, [Constraint CodeExpr])] -> ConstraintCEMap)
-> ([c] -> [(UID, [Constraint CodeExpr])])
-> [c]
-> ConstraintCEMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> (UID, [Constraint CodeExpr]))
-> [c] -> [(UID, [Constraint CodeExpr])]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: c
x -> (c
x c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Lens' c UID
uid, (ConstraintE -> Constraint CodeExpr)
-> [ConstraintE] -> [Constraint CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map ConstraintE -> Constraint CodeExpr
constraint ([ConstraintE] -> [Constraint CodeExpr])
-> [ConstraintE] -> [Constraint CodeExpr]
forall a b. (a -> b) -> a -> b
$ c
x c -> Getting [ConstraintE] c [ConstraintE] -> [ConstraintE]
forall s a. s -> Getting a s a -> a
^. Getting [ConstraintE] c [ConstraintE]
forall c. Constrained c => Lens' c [ConstraintE]
constraints))
physLookup :: HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup :: ConstraintCEMap -> q -> (q, [Constraint CodeExpr])
physLookup m :: ConstraintCEMap
m q :: q
q = q
-> ConstraintCEMap
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> (q, [Constraint CodeExpr])
forall q.
HasUID q =>
q
-> ConstraintCEMap
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> (q, [Constraint CodeExpr])
constraintLookup q
q ConstraintCEMap
m ((Constraint CodeExpr -> Bool)
-> [Constraint CodeExpr] -> [Constraint CodeExpr]
forall a. (a -> Bool) -> [a] -> [a]
filter Constraint CodeExpr -> Bool
forall e. Constraint e -> Bool
isPhysC)
sfwrLookup :: HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup :: ConstraintCEMap -> q -> (q, [Constraint CodeExpr])
sfwrLookup m :: ConstraintCEMap
m q :: q
q = q
-> ConstraintCEMap
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> (q, [Constraint CodeExpr])
forall q.
HasUID q =>
q
-> ConstraintCEMap
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> (q, [Constraint CodeExpr])
constraintLookup q
q ConstraintCEMap
m ((Constraint CodeExpr -> Bool)
-> [Constraint CodeExpr] -> [Constraint CodeExpr]
forall a. (a -> Bool) -> [a] -> [a]
filter Constraint CodeExpr -> Bool
forall e. Constraint e -> Bool
isSfwrC)
constraintLookup :: HasUID q => q -> ConstraintCEMap
-> ([ConstraintCE] -> [ConstraintCE]) -> (q, [ConstraintCE])
constraintLookup :: q
-> ConstraintCEMap
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> (q, [Constraint CodeExpr])
constraintLookup q :: q
q m :: ConstraintCEMap
m filt :: [Constraint CodeExpr] -> [Constraint CodeExpr]
filt = (q
q, [Constraint CodeExpr]
-> ([Constraint CodeExpr] -> [Constraint CodeExpr])
-> Maybe [Constraint CodeExpr]
-> [Constraint CodeExpr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Constraint CodeExpr] -> [Constraint CodeExpr]
filt (UID -> ConstraintCEMap -> Maybe [Constraint CodeExpr]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (q
q q -> Getting UID q UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID q UID
forall c. HasUID c => Lens' c UID
uid) ConstraintCEMap
m))