renderable (empty) → 0.0.0.1

raw patch · 4 files changed

+277/−0 lines, 4 filesdep +basedep +containersdep +hashablesetup-changed

Dependencies added: base, containers, hashable

Files

LICENSE +20/−0
Setup.hs +2/−0
renderable.cabal +80/−0
src/Data/Renderable.hs +175/−0

+ LICENSE view

@@ -0,0 +1,20 @@+Copyright (c) 2015 Schell Scivally++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ renderable.cabal view

@@ -0,0 +1,80 @@+-- Initial renderable.cabal generated by cabal init.  For further+-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                renderable++-- The package version.  See the Haskell package versioning policy (PVP)+-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.0.0.1++-- A short (one-line) description of the package.+synopsis:            Provides a nice API for rendering data types that change+                     over time.++-- A longer description of the package.+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.++-- URL for the project homepage or repository.+homepage:            http://zyghost.com++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              Schell Scivally++-- An email address to which users can send suggestions, bug reports, and+-- patches.+maintainer:          efsubenovex@gmail.com++-- A copyright notice.+-- copyright:++category:            Graphics++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10++source-repository head+  type:     git+  location: https://github.com/schell/renderable.git++library+  ghc-options:         -Wall+  -- Modules exported by the library.+  exposed-modules:     Data.Renderable++  -- Modules included in this library but not exported.+  -- other-modules:++  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    TypeFamilies, GADTs, FlexibleContexts++  -- Other library packages from which modules are imported.+  build-depends:       base >=4.8 && <4.9,+                       containers >= 0.5 && < 0.6,+                       hashable >= 1.2 && < 1.3++  -- Directories containing source files.+  hs-source-dirs:      src++  -- Base language which the package is written in.+  default-language:    Haskell2010+

+ src/Data/Renderable.hs view

@@ -0,0 +1,175 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleContexts #-}+module Data.Renderable where++import Prelude hiding (lookup)+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++--------------------------------------------------------------------------------+-- Other Renderables+--------------------------------------------------------------------------------+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++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 (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+--------------------------------------------------------------------------------+-- Rendering and cacheing+--------------------------------------------------------------------------------+-- | 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++-- | 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++-- | 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+                                                ]++-- | 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'++-- | 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++-- | 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+--------------------------------------------------------------------------------+-- Element+--------------------------------------------------------------------------------+instance Hashable (Element m r t) where+    hashWithSalt s (Element a) = s `hashWithSalt` "Element" `hashWithSalt` a++instance Eq (Element m r t) where+    a == b = hash a == hash b++instance Show (Element m r t) where+    show (Element a) = "Element{ " ++ show a ++ " }"++-- | Element is a generic type that can be used to enclose homogenous+-- instances of Renderable. 'm', 'r' and 't' are shared with all Renderable+-- instances stored in an Element.+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+--------------------------------------------------------------------------------+-- Renderable+--------------------------------------------------------------------------------+class Renderable a where+    type RenderMonad a :: * -> *+    type RenderTfrm a  :: *+    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)++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 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 composite is a representation of the entire rendered datatype. It is+-- a flattened list of all the renderings (denoted by hash), along with+-- that renderings 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)]