module Control.Dependency ( Require
, require
, requireFilter
, computeRequire
, isComputable
, triggersAnalyzer
) where
import Control.Applicative
import qualified Data.Set as S
import qualified Data.Foldable as F
import Data.Profunctor
data Require identifier content a where
Require :: (identifier -> Bool) -> Require identifier content (identifier, content)
Pure :: a -> Require identifier content a
Ap :: Require identifier content (a -> b) -> Require identifier content a -> Require identifier content b
Alt :: Require identifier content a -> Require identifier content a -> Require identifier content a
Empty :: Require identifier content a
HoistContent :: (content -> prevcontent) -> Require identifier prevcontent a -> Require identifier content a
instance Functor (Require identifier content) where
fmap f = Ap (Pure f)
instance Applicative (Require identifier content) where
pure = Pure
(<*>) = Ap
instance Alternative (Require identifier content) where
empty = Empty
(<|>) = Alt
instance Profunctor (Require identifier) where
dimap f g = fmap g . HoistContent f
require :: Eq identifier => identifier -> Require identifier content content
require = fmap snd . Require . (==)
requireFilter :: (identifier -> Bool) -> Require identifier content (identifier, content)
requireFilter = Require
computeRequire :: (Ord identifier, Eq identifier, Applicative f, Alternative f)
=> [(identifier, content)]
-> Require identifier content a
-> f a
computeRequire _ Empty = empty
computeRequire _ (Pure x) = pure x
computeRequire s (Require i) = case filter ( i . fst ) s of
[] -> empty
x:_ -> pure x
computeRequire s (Ap r1 r2) = computeRequire s r1 <*> computeRequire s r2
computeRequire s (Alt r1 r2) = computeRequire s r1 <|> computeRequire s r2
computeRequire s (HoistContent f r) = computeRequire (map (\(i,c) -> (i, f c)) s) r
isComputable :: (Ord identifier, Eq identifier)
=> S.Set identifier
-> Require identifier content a
-> Bool
isComputable _ Empty = False
isComputable _ (Pure _) = True
isComputable s (Require i) = F.any i s
isComputable s (Ap r1 r2) = isComputable s r1 && isComputable s r2
isComputable s (Alt r1 r2) = isComputable s r1 || isComputable s r2
isComputable s (HoistContent _ f) = isComputable s f
triggersAnalyzer :: identifier -> Require identifier content a -> Bool
triggersAnalyzer _ Empty = False
triggersAnalyzer _ (Pure _) = False
triggersAnalyzer s (Require i) = i s
triggersAnalyzer s (Ap r1 r2) = triggersAnalyzer s r1 || triggersAnalyzer s r2
triggersAnalyzer s (Alt r1 r2) = triggersAnalyzer s r1 || triggersAnalyzer s r2
triggersAnalyzer s (HoistContent _ f) = triggersAnalyzer s f