{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Hyper.Internal (
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
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)
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
html :: T.Text -> Graphic
html :: Text -> Graphic
html = Text -> Graphic
Graphic
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
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 []