module Control.Tweak.Internal where
import Control.Tweak.Var
import Control.Tweak.Tweakable
import Control.Concurrent.STM
import Control.Applicative
data Maker a = Maker { runmaker :: IO (Tweakable a) }
make :: Tweakable a -> Maker a
make = Maker . pure
instance Functor Maker where
fmap f (Maker mx) = Maker $ do
af <- Pure <$> newVar f
apply (return af) mx
instance Applicative Maker where
pure = Maker . fmap Pure . newVar
Maker mf <*> Maker mx = Maker $ do
apply mf mx
apply :: IO (Tweakable (a -> b)) -> IO (Tweakable a) -> IO (Tweakable b)
apply mf mx = do
x <- mx
f <- mf
let evalApp = readCacheSTM f <*> readCacheSTM x
c <- atomically $ newVarSTM =<< evalApp
let updater = writeVarSTM c =<< evalApp
addChild x (AnyVar c) updater
addChild f (AnyVar c) updater
return $ App c f x
class Funktor g f where
fcrap :: (a -> b) -> f a -> g b
instance Funktor Maker Var where
fcrap f = fcrap f . Pure
instance Funktor Maker Tweakable where
fcrap f = fcrap f . make
instance Funktor Maker Maker where
fcrap = fmap
infixl 4 .$.
(.$.) :: Funktor g f => (a -> b) -> f a -> g b
(.$.) = fcrap
infixl 4 .*.
(.*.) :: Comply g h => g (a -> b) -> h a -> g b
(.*.) = connect
class Comply g h where
connect :: g (a -> b) -> h a -> g b
instance Comply Maker Var where
connect f = connect f . Pure
instance Comply Maker Tweakable where
connect f = connect f . make
instance Comply Maker Maker where
connect f x = f <*> x