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.CodeExpr.Development (CodeExpr, constraint)
import qualified Data.Map as Map

-- | Type synonym for 'Constraint CodeExpr'
type ConstraintCE = Constraint CodeExpr

-- | Constraints map. Contains all 'Constraint's.
type ConstraintCEMap = Map.Map UID [ConstraintCE]

-- | Creates a map from 'UID' to 'Constraint's for constrained chunks.
constraintMap :: (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap :: forall c. (HasUID c, Constrained c) => [c] -> ConstraintCEMap
constraintMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\c
x -> (c
x forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid, forall a b. (a -> b) -> [a] -> [b]
map ConstraintE -> ConstraintCE
constraint forall a b. (a -> b) -> a -> b
$ c
x forall s a. s -> Getting a s a -> a
^. forall c. Constrained c => Lens' c [ConstraintE]
constraints))

-- | Returns a pair of a chunk and its physical constraints.
physLookup :: HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup :: forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
physLookup ConstraintCEMap
m q
q = forall q.
HasUID q =>
q
-> ConstraintCEMap
-> ([ConstraintCE] -> [ConstraintCE])
-> (q, [ConstraintCE])
constraintLookup q
q ConstraintCEMap
m (forall a. (a -> Bool) -> [a] -> [a]
filter forall e. Constraint e -> Bool
isPhysC)

-- | Returns a pair of a chunk and its software constraints.
sfwrLookup :: HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup :: forall q. HasUID q => ConstraintCEMap -> q -> (q, [ConstraintCE])
sfwrLookup ConstraintCEMap
m q
q = forall q.
HasUID q =>
q
-> ConstraintCEMap
-> ([ConstraintCE] -> [ConstraintCE])
-> (q, [ConstraintCE])
constraintLookup q
q ConstraintCEMap
m (forall a. (a -> Bool) -> [a] -> [a]
filter forall e. Constraint e -> Bool
isSfwrC)

-- | Returns a chunk and a filtered list of its constraints.
constraintLookup :: HasUID q => q -> ConstraintCEMap
                      -> ([ConstraintCE] -> [ConstraintCE]) -> (q, [ConstraintCE])
constraintLookup :: forall q.
HasUID q =>
q
-> ConstraintCEMap
-> ([ConstraintCE] -> [ConstraintCE])
-> (q, [ConstraintCE])
constraintLookup q
q ConstraintCEMap
m [ConstraintCE] -> [ConstraintCE]
filt = (q
q, forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [ConstraintCE] -> [ConstraintCE]
filt (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (q
q forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) ConstraintCEMap
m))