module Data.Faceted.Internal(
Label,
Faceted(Raw,Faceted),
PC,
Branch(Private,Public),
View,
FIO(FIO),
pcF,
project,
visibleTo
) where
import Control.Applicative
import Control.Monad
import Data.IORef
import Data.List
import System.IO
import Data.Dynamic
type Label = String
type View = [Label]
data Faceted a =
Raw a
| Faceted Label (Faceted a) (Faceted a)
deriving (Show, Eq, Typeable)
instance Functor Faceted where
fmap f (Raw v) = Raw (f v)
fmap f (Faceted k priv pub) = Faceted k (fmap f priv) (fmap f pub)
instance Applicative Faceted where
pure x = Raw x
(Raw f) <*> x = fmap f x
(Faceted k priv pub) <*> x = Faceted k (priv <*> x) (pub <*> x)
instance Monad Faceted where
return x = Raw x
(Raw x) >>= f = f x
(Faceted k priv pub) >>= f = Faceted k (priv >>= f) (pub >>= f)
data Branch = Public Label | Private Label deriving (Eq, Show)
type PC = [Branch]
pcF :: PC -> Faceted a -> Faceted a -> Faceted a
pcF [] x _ = x
pcF (Private k : branches) x y = Faceted k (pcF branches x y) y
pcF (Public k : branches) x y = Faceted k y (pcF branches x y)
project :: View -> Faceted a -> a
project view (Raw v) = v
project view (Faceted k priv pub)
| k `elem` view = project view priv
| k `notElem` view = project view pub
visibleTo :: PC -> View -> Bool
visibleTo pc view = all consistent pc
where consistent (Private k) = k `elem` view
consistent (Public k) = k `notElem` view
data FIO a = FIO { runFIO :: PC -> IO a }
instance Monad FIO where
return x = FIO (\pc -> return x)
x >>= f = FIO (\pc -> do v <- runFIO x pc
runFIO (f v) pc)