renderable 0.0.0.2 → 0.1.0.0

raw patch · 2 files changed

+134/−181 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• renderable.cabal +2/−2
• src/Data/Renderable.hs +132/−179

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.0.0.2+version:             0.1.0.0  -- A short (one-line) description of the package. synopsis:            Provides a nice API for rendering data types that change@@ -20,7 +20,7 @@ description: Instances of Renderable conform to a simple API that makes their              visual representations composable through hashing and cacheing.              Also provided are some convenience functions for writing-             Renderable instances, as well as top level rendering functions.+             Renderable instances. Not provided are actual rendering functions.  -- URL for the project homepage or repository. homepage:            http://zyghost.com

@@ -3,209 +3,162 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-module Data.Renderable where+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Data.Renderable (+    Primitive(..),+    Element(..),+    Composite(..),+    Rendering,+    Cache,+    renderData+) where  import Prelude hiding (lookup)+import Control.Arrow (first) import Control.Monad import Data.Hashable import Data.IntMap (IntMap)-import Data.Maybe-import Data.Monoid-import Data.List (intercalate)-import qualified Data.IntSet as S import qualified Data.IntMap as IM-import GHC.Stack- ----------------------------------------------------------------------------------- Decomposable Instances+-- Primitives ----------------------------------------------------------------------------------- | Any element is decomposable by returning a list consisting of itself.-instance Decomposable (Element m r t) m r t where-    decompose e = [e]+-- | A 'Primitive' is the smallest thing can can be rendered in your graphics+-- system. Some examples are points, lines, triangles and other shapes.+class Primitive a where+    -- | The monad in which rendering calls will take place.+    type PrimM a :: * -> *+    -- | The type of the graphics transformation.+    type PrimT a :: *+    -- | The datatype that holds cached resources such as references to+    -- windows, shaders, etc.+    type PrimR a :: *+    -- | Allocate resources for rendering the primitive and return+    -- a monadic call that renders the primitive using a transform. Tuple+    -- that with a call to clean up the allocated resources.+    compilePrimitive :: Monad (PrimM a)+                     => PrimR a+                     -> a+                     -> (PrimM a) (Rendering (PrimM a) (PrimT a)) ----------------------------------------------------------------------------------- Renderable Instances+-- Element ----------------------------------------------------------------------------------- | Any Element is renderable by rendering its contained datatype.-instance Renderable (Element m r t) where-    type RenderMonad (Element m r t) = m-    type RenderRsrc (Element m r t) = r-    type RenderTfrm (Element m r t) = t-    cache rz rs (Element a)   = attachIfNeeded rz rs a-    nameOf (Element a)        = "Element " ++ nameOf a-    composite (Element a) = composite a---- | A tuple is renderable when it is a pairing of a transform and another--- renderable datatype.-instance ( t ~ RenderTfrm a, Show t, Monoid t-         , Hashable a, Renderable a) => Renderable (t,a) where-    type RenderMonad (t,a) = RenderMonad a-    type RenderTfrm (t,a) = RenderTfrm a-    type RenderRsrc (t,a) = RenderRsrc a-    cache rz rs (_,a) = attachIfNeeded rz rs a-    nameOf (t,a) = "(" ++ show t ++ ", " ++ nameOf a ++ ")"-    composite (t,a) = map (fmap $ fmap (t <>)) $ composite a+-- | Element is an existential type that can be used to enclose+-- instances of Primitive in order to contain them all in a heterogeneous list.+-- 'm', 'r' and 't' must be shared with all Primitive instances stored in+-- the heterogeneous list of Elements.+data Element m r t where+    Element  :: ( Monad m, Hashable a, Primitive a+                , m ~ PrimM a+                , r ~ PrimR a+                , t ~ PrimT a)+             => a -> Element m r t --- | A Maybe is renderable by rendering the datatype contained in the Just--- constructor or by rendering nothing.-instance (Renderable a, Hashable a, Show a) => Renderable (Maybe a) where-    type RenderMonad (Maybe a) = RenderMonad a-    type RenderTfrm (Maybe a) = RenderTfrm a-    type RenderRsrc (Maybe a) = RenderRsrc a-    cache rz rs (Just a) = attachIfNeeded rz rs a-    cache _ rs _         = return rs-    nameOf (Just a) = "Just " ++ nameOf a-    nameOf _        = "Nothing"-    composite (Just a) = composite a-    composite _ = []+instance Hashable (Element m r t) where+    hashWithSalt s (Element a) = s `hashWithSalt` "Element" `hashWithSalt` a --- | A list of renderable instances is renderable by rendering each--- instance.-instance (Renderable a, Hashable a) => Renderable [a] where-    type RenderMonad [a] = RenderMonad a-    type RenderTfrm [a] = RenderTfrm a-    type RenderRsrc [a] = RenderRsrc a-    cache = foldM . attachIfNeeded-    nameOf as = "[ " ++ (intercalate ", " names) ++ " ]"-        where names = map nameOf as-    composite = concatMap composite+instance Eq (Element m r t) where+    a == b = hash a == hash b ----------------------------------------------------------------------------------- Rendering and cacheing+-- Compositing ----------------------------------------------------------------------------------- | Render a datatype using renderings stored in the given cache.-renderData :: (Monad m, Renderable a, Monoid (RenderTfrm a))-           => Cache m (RenderTfrm a) -> a -> m ()-renderData c = renderComposite c mempty . composite+-- | A 'Composite' is a type that can be broken down into a list of+-- transformed primitives.+class Composite a m r t where+    -- | Break down a 'Composite' into a heterogeneous list of transformed+    -- primitives.+    composite :: a -> [(t, Element m r t)]+--------------------------------------------------------------------------------+-- Rendering+--------------------------------------------------------------------------------+-- | A rendering is a type that contains some effectful computation for+-- displaying something given a transform. It also contains an effectful+-- computation for cleaning up any resources allocated during its creation.+type Rendering m t = (m (), t -> m ()) --- | Render only the hidden layers of a datatype using renderings stored in--- the given cache. This is sometimes useful for debugging.-renderDataHidden :: (Renderable a, Monad m, Monoid (RenderTfrm a))-                 => Cache m (RenderTfrm a) -> (RenderTfrm a) -> a -> m ()-renderDataHidden c t = renderComposite c t . catMaybes . map f . composite-    where f (i, Nothing) = Just (i, Just mempty)-          f _ = Nothing+-- | A cache of renderings.+type Cache m t = IntMap (Rendering m t) --- | Render the composite of a datatype using renderings stored in the--- given cache.-renderComposite :: (Monad m, Monoid t) => Cache m t -> t -> Composite t -> m ()-renderComposite rs t = mapM_ (uncurry go)-    where go k (Just t') = maybe (err k) (rend t') $ IM.lookup k rs-          go _ _ = return ()-          rend t' (Rendering f _) = f $ t <> t'-          err k = errorWithStackTrace $ unwords [ "Fatal error! Could not find"-                                                , "rendering (from a layer)"-                                                , show k-                                                ]+instance Monad m => Monoid (Rendering m t) where+    (ca, fa) `mappend` (cb, fb) = (ca >> cb, \t -> fa t >> fb t)+    mempty = (return (), const $ return ()) --- | If needed, create a new rendering given some resources, insert it in--- the cache and return the new cache.-attachIfNeeded :: ( Renderable a, Monad (RenderMonad a)-                 , Monoid (RenderTfrm a), Hashable a)-              => RenderRsrc a -> Cache (RenderMonad a) (RenderTfrm a)-              -> a -> (RenderMonad a) (Cache (RenderMonad a) (RenderTfrm a))-attachIfNeeded rz cache' a =-    maybe (cache rz cache' a) (const $ return cache') $ IM.lookup (hash a) cache'+findRenderer :: Monad m+             => Cache m t+             -> (Cache m t, IntMap (Element m r t))+             -> Element m r t+             -> (Cache m t, IntMap (Element m r t))+findRenderer cache (found, missing) a =+    let k = hash a in+    case IM.lookup k cache of+        Nothing -> (found, IM.insert k a missing)+        Just r  -> (IM.insert k r found, missing) --- | Detach any renderings that are not needed to render the--- given data.-detachUnused :: (Monad m, Renderable a) => Cache m t -> a -> m (Cache m t)-detachUnused c a =-    -- Get the hashes listed in the composite (these are used)-    let hashes = S.fromList $ map fst $ composite a-        -- Get the hashes currently in the cache-        keys = IM.keysSet c-        -- Diff them-        diff = S.difference keys hashes-        -- Detach them-    in foldM detach c $ S.toList diff+getRenderer :: (Primitive a, Hashable a, Monad (PrimM a))+            => PrimR a+            -> Cache (PrimM a) (PrimT a)+            -> a+            -> (PrimM a) (Cache (PrimM a) (PrimT a))+getRenderer rez cache a = do+    r <- compilePrimitive rez a+    return $ IM.insert (hash a) r cache --- | Remove a rendering from a cache and clean up the resources allocated--- for that rendering.-detach :: Monad m => Cache m t -> Int -> m (Cache m t)-detach c k = do-    case IM.lookup k c of-        Nothing        -> let s = "Could not find rendering for " ++ show k-                          in errorWithStackTrace s-        Just rendering -> clean rendering-    return $ IM.delete k c------------------------------------------------------------------------------------ Decomposition------------------------------------------------------------------------------------ | An instance of Decomposable can be broken down into a number of elements.-class Decomposable a m r t where-    decompose :: a -> [Element m r t]------------------------------------------------------------------------------------ Element----------------------------------------------------------------------------------instance Hashable (Element m r t) where-    hashWithSalt s (Element a) = s `hashWithSalt` "Element" `hashWithSalt` a+getElementRenderer :: r -> Cache m t -> Element m r t -> m (Cache m t)+getElementRenderer rez cache (Element a) = getRenderer rez cache a -instance Eq (Element m r t) where-    a == b = hash a == hash b+clean :: Rendering m t -> m ()+clean = fst -instance Show (Element m r t) where-    show (Element a) = "Element{ " ++ show a ++ " }"+render :: Rendering m t -> t -> m ()+render = snd --- | Element is a generic existential type that can be used to enclose--- instances of Renderable in order to contain them all in a heterogeneous list.--- 'm', 'r' and 't' must be shared with all Renderable instances stored in--- a heterogeneous list of Elements.-data Element m r t where-    Element  :: ( Monad m, Show a, Hashable a, Renderable a-                , m ~ RenderMonad a-                , r ~ RenderRsrc a-                , t ~ RenderTfrm a)-             => a -> Element m r t+renderElement :: Monad m => Cache m t -> t -> Element m r t -> m ()+renderElement cache t (Element a) = do+    let k = hash a+    case IM.lookup k cache of+        Nothing -> return ()+        Just r  -> render r t++-- | Render a datatype using renderings stored in the given cache, return a+-- new cache that can be used to render the next datatype.+renderData :: (Composite a m r t, Hashable a, Monad m, Monoid t)+           => r -> Cache m t -> a -> m (Cache m t)+renderData rez cache a = do+        -- comp is a heterogeneous list of all the primitives needed to render+        -- this datatype  'a'.+    let comp = composite a+        (found, missing) = foldl (findRenderer cache) (mempty, mempty) $ map snd comp+        stale = cache `IM.difference` found++    -- Clean the stale renderers+    sequence_ $ fmap clean stale++    -- Get the missing renderers+    new <- foldM (getElementRenderer rez) mempty $ IM.elems missing++    let next = IM.union found new+    -- Render the composite+    mapM_ (uncurry $ renderElement next) comp+    return next ----------------------------------------------------------------------------------- Renderable+-- Instances ---------------------------------------------------------------------------------class Renderable a where-    -- | The monad needed to render the datatype.  In most cases this is-    -- probably IO.-    type RenderMonad a :: * -> *-    -- | The datatype that is used to transform renderings.-    type RenderTfrm a  :: *-    -- | The datatype that holds cached resources that will be used to-    -- composite and render the datatype.-    type RenderRsrc a  :: *-    -- | The name of a renderable datatype. This is mostly for debugging.-    nameOf :: a -> String-    -- | Store the rendering of a datatype in a cache keyed by the hash of that-    -- datatype. Returns the new cache.-    cache :: (Monad (RenderMonad a), Monoid (RenderTfrm a))-          => RenderRsrc a -> Cache (RenderMonad a) (RenderTfrm a) -> a-          -> (RenderMonad a) (Cache (RenderMonad a) (RenderTfrm a))-    -- | The entire composite list of renderings for a given datatype.-    composite :: a -> Composite (RenderTfrm a)---- | A cache of renderings.-type Cache m t = IntMap (Rendering m t)+-- | Any Element is a composite of itself if its transform type is a monoid.+instance Monoid t => Composite (Element m r t) m r t where+    composite e = [(mempty, e)] -instance Monad m => Monoid (Rendering m t) where-    (Rendering a b) `mappend` (Rendering c d) =-        Rendering (\t -> a t >> c t) (b >> d)-    mempty = Rendering (const $ return ()) (return ())+-- | A tuple is a composite if its right type is a composite and the+-- left type is the transform and the transform is a Monoid. In this case the+-- result is the right type transformed by the left type.+instance (Monoid t, Composite a m r t) => Composite (t,a) m r t where+    composite (t, a) = map (first (mappend t)) $ composite a --- | A rendering is a type that contains some effectful computation for--- displaying something given a transform. It also contains an effectful--- computation for cleaning up any resources allocated during its creation.-data Rendering m t = Rendering { render :: t -> m ()-                               , clean  :: m ()-                               }+-- | A Maybe is a composite if its contained type is composite. The result+-- is is the composite of its contained type or an empty list.+instance Composite a m r t => Composite (Maybe a) m r t where+    composite (Just a) = composite a+    composite _ = [] --- | A composite is a representation of the entire rendered datatype. It is--- a flattened list of all the renderings (denoted by hash), along with--- that rendering\'s local transformation. If a rendering is explicitly run--- by another rendering (as in a Renderable class definition) then the--- transformation for that rendering should be Nothing, which will keep--- 'renderComposite' from running that rendering in addition to the--- rendering its included in. For example:--- @--- [(0, Just $ Transform (10,10) (0.5,0.5) 0)--- ,(1, Nothing)--- ]--- @--- The above is a composite of two renderings, the first will be rendered--- by 'renderComposite' using the given transform while the second is--- effectively hidden but present. Being present in the composite will keep--- 'detachUnused' from detaching and cleaning the rendering.-type Composite a = [(Int, Maybe a)]+-- | A list is a composite by compositing each element and concatenating+-- the result.+instance Composite a m r t => Composite [a] m r t where+    composite = concatMap composite