Internal.hs

{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Hyper.Internal (
    -- * Synopsis
    -- | Internal data types used by the HyperHaskell back-end
    -- to analyze values constructed with the 'Hyper' module.
    
    -- * Documentation
    Graphic(..), string, html,
    Display(..),
    finalizeSession, addFinalizerSession,
    ) where

import           Control.DeepSeq
import           Data.IORef
import           Data.List            (isPrefixOf)
import           Data.Typeable
import           System.IO.Unsafe     (unsafePerformIO)

import qualified Data.Text        as T
import qualified Data.Text.Lazy   as TL
import qualified Text.Blaze.Html  as H
import qualified Text.Blaze.Html5 as H
import qualified Text.Blaze.Html.Renderer.Text as H

{-----------------------------------------------------------------------------
    Graphics
------------------------------------------------------------------------------}
-- | A graphical representation of data.
data Graphic = Graphic { gHtml :: T.Text } deriving (Typeable)

instance NFData Graphic where rnf g = rnf (gHtml g)

-- | Render a 'String' as a 'Graphic'.
string :: String -> Graphic
string = Graphic . TL.toStrict . H.renderHtml . H.div . H.toHtml

-- | Render arbitrary HTML code as a 'Graphic'.
-- 
-- NOTE: This function does not do check whether the input is well-formed HTML.
--
-- NOTE: This function will probably deprecated once we figure out
-- how to do this properly, but for now, just use it.
html :: T.Text -> Graphic
html = Graphic

{-----------------------------------------------------------------------------
    Display class
------------------------------------------------------------------------------}
-- | Class for displaying Haskell values.
class Display a where
    display   :: a -> Graphic
    displayIO :: a -> IO Graphic

    displayIO = return . display

instance Display ()           where display x = x `seq` fromShow x
instance Display Graphic      where display = id
instance Display Bool         where display = fromShow
instance Display Double       where display = fromShow
instance Display Integer      where display = fromShow
instance Display Int          where display = fromShow
instance Display String       where display = fromShow
instance Display [Int]        where display = displayList
instance Display [String]     where display = displayList

instance Display a => Display (IO a) where
    display   _ = string "<<IO action>>"
    displayIO m = fmap display m

fromShow :: Show a => a -> Graphic
fromShow = string . show

displayList :: Show a => [a] -> Graphic
displayList = fromShow

{-----------------------------------------------------------------------------
    Interpreter management
------------------------------------------------------------------------------}
refFinalizers :: IORef [IO ()]
refFinalizers = unsafePerformIO $ newIORef []

addFinalizerSession :: IO () -> IO ()
addFinalizerSession m = modifyIORef refFinalizers (m:)

finalizeSession :: IO ()
finalizeSession = do
    sequence_ =<< readIORef refFinalizers
    writeIORef refFinalizers []