{-# 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 { Graphic -> Text
gHtml :: T.Text } deriving (Typeable)

instance NFData Graphic where rnf :: Graphic -> ()
rnf Graphic
g = Text -> ()
forall a. NFData a => a -> ()
rnf (Graphic -> Text
gHtml Graphic
g)

-- | Render a 'String' as a 'Graphic'.
string :: String -> Graphic
string :: String -> Graphic
string = Text -> Graphic
Graphic (Text -> Graphic) -> (String -> Text) -> String -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Text
H.renderHtml (Html -> Text) -> (String -> Html) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Html -> Html
H.div (Html -> Html) -> (String -> Html) -> String -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Html
forall a. ToMarkup a => a -> Html
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 :: Text -> Graphic
html = Text -> Graphic
Graphic

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

    displayIO = Graphic -> IO Graphic
forall (m :: * -> *) a. Monad m => a -> m a
return (Graphic -> IO Graphic) -> (a -> Graphic) -> a -> IO Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Graphic
forall a. Display a => a -> Graphic
display

instance Display ()           where display :: () -> Graphic
display ()
x = ()
x () -> Graphic -> Graphic
`seq` () -> Graphic
forall a. Show a => a -> Graphic
fromShow ()
x
instance Display Graphic      where display :: Graphic -> Graphic
display = Graphic -> Graphic
forall a. a -> a
id
instance Display Bool         where display :: Bool -> Graphic
display = Bool -> Graphic
forall a. Show a => a -> Graphic
fromShow
instance Display Double       where display :: Double -> Graphic
display = Double -> Graphic
forall a. Show a => a -> Graphic
fromShow
instance Display Integer      where display :: Integer -> Graphic
display = Integer -> Graphic
forall a. Show a => a -> Graphic
fromShow
instance Display Int          where display :: Int -> Graphic
display = Int -> Graphic
forall a. Show a => a -> Graphic
fromShow
instance Display String       where display :: String -> Graphic
display = String -> Graphic
forall a. Show a => a -> Graphic
fromShow
instance Display [Int]        where display :: [Int] -> Graphic
display = [Int] -> Graphic
forall a. Show a => [a] -> Graphic
displayList
instance Display [String]     where display :: [String] -> Graphic
display = [String] -> Graphic
forall a. Show a => [a] -> Graphic
displayList

instance Display a => Display (IO a) where
    display :: IO a -> Graphic
display   IO a
_ = String -> Graphic
string String
"<<IO action>>"
    displayIO :: IO a -> IO Graphic
displayIO IO a
m = (a -> Graphic) -> IO a -> IO Graphic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Graphic
forall a. Display a => a -> Graphic
display IO a
m

fromShow :: Show a => a -> Graphic
fromShow :: a -> Graphic
fromShow = String -> Graphic
string (String -> Graphic) -> (a -> String) -> a -> Graphic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

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

{-----------------------------------------------------------------------------
    Interpreter management
------------------------------------------------------------------------------}
refFinalizers :: IORef [IO ()]
refFinalizers :: IORef [IO ()]
refFinalizers = IO (IORef [IO ()]) -> IORef [IO ()]
forall a. IO a -> a
unsafePerformIO (IO (IORef [IO ()]) -> IORef [IO ()])
-> IO (IORef [IO ()]) -> IORef [IO ()]
forall a b. (a -> b) -> a -> b
$ [IO ()] -> IO (IORef [IO ()])
forall a. a -> IO (IORef a)
newIORef []

addFinalizerSession :: IO () -> IO ()
addFinalizerSession :: IO () -> IO ()
addFinalizerSession IO ()
m = IORef [IO ()] -> ([IO ()] -> [IO ()]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [IO ()]
refFinalizers (IO ()
mIO () -> [IO ()] -> [IO ()]
forall a. a -> [a] -> [a]
:)

finalizeSession :: IO ()
finalizeSession :: IO ()
finalizeSession = do
    [IO ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([IO ()] -> IO ()) -> IO [IO ()] -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IORef [IO ()] -> IO [IO ()]
forall a. IORef a -> IO a
readIORef IORef [IO ()]
refFinalizers
    IORef [IO ()] -> [IO ()] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [IO ()]
refFinalizers []