module Graphics.UI.Threepenny.Internal.Types
where
import Prelude hiding ((++),init)
import Control.Applicative
import Control.Concurrent
import qualified Control.Event as E
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Data.Map (Map)
import Data.Time
import Network.URI
import Text.JSON.Generic
data Element = Element
{ elId :: ElementId
, elSession :: Session
}
instance Show Element where
show = show . elId
data ElementId = ElementId String
deriving (Data,Typeable,Show)
instance JSON ElementId where
showJSON (ElementId o) = showJSON o
readJSON obj = do
obj <- readJSON obj
ElementId <$> valFromObj "Element" obj
data Session = Session
{ sSignals :: Chan Signal
, sInstructions :: Chan Instruction
, sEvent :: EventKey -> E.Event EventData
, sEventHandler :: E.Handler (EventKey, EventData)
, sClosures :: MVar [Integer]
, sElementIds :: MVar [Integer]
, sToken :: Integer
, sMutex :: MVar ()
, sConnectedState :: MVar ConnectedState
, sThreadId :: ThreadId
, sStartInfo :: (URI,[(String,String)])
, sServerState :: ServerState
}
type Sessions = Map Integer Session
type MimeType = ByteString
type Filepaths = (Integer, Map ByteString (FilePath, MimeType))
data ServerState = ServerState
{ sSessions :: MVar Sessions
, sFiles :: MVar Filepaths
, sDirs :: MVar Filepaths
}
type EventKey = (String, String)
type Window = Session
data ConnectedState
= Disconnected UTCTime
| Connected
deriving (Show)
data EventData = EventData [Maybe String]
data Instruction
= Debug String
| Begin ()
| End ()
| SetToken Integer
| Clear ()
| GetElementsById [String]
| GetElementsByTagName String
| SetStyle ElementId [(String,String)]
| SetAttr ElementId String String
| Append ElementId ElementId
| SetText ElementId String
| SetHtml ElementId String
| Bind String ElementId Closure
| GetValue ElementId
| GetValues [ElementId]
| SetTitle String
| GetLocation ()
| CallFunction (String,[String])
| CallDeferredFunction (Closure,String,[String])
| EmptyEl ElementId
| Delete ElementId
deriving (Typeable,Data,Show)
data Signal
= Init ()
| Elements [ElementId]
| Event (String,String,[Maybe String])
| Value String
| Values [String]
| Location String
| FunctionCallValues [Maybe String]
deriving (Show)
instance JSON Signal where
showJSON _ = error "JSON.Signal.showJSON: No method implemented."
readJSON obj = do
obj <- readJSON obj
let init = Init <$> valFromObj "Init" obj
elements = Elements <$> valFromObj "Elements" obj
event = do
(cid,typ,arguments) <- valFromObj "Event" obj
args <- mapM nullable arguments
return $ Event (cid,typ,args)
value = Value <$> valFromObj "Value" obj
location = Location <$> valFromObj "Location" obj
values = Values <$> valFromObj "Values" obj
fcallvalues = do
FunctionCallValues <$> (valFromObj "FunctionCallValues" obj >>= mapM nullable)
init <|> elements <|> event <|> value <|> values <|> location <|> fcallvalues
nullable :: JSON a => JSValue -> Result (Maybe a)
nullable JSNull = return Nothing
nullable v = Just <$> readJSON v
data Closure = Closure (String,String)
deriving (Typeable,Data,Show)
data Config = Config
{ tpPort :: Int
, tpCustomHTML :: Maybe FilePath
, tpStatic :: FilePath
}