dingo-core 0.0.3.1 → 0.0.3.2
raw patch · 6 files changed
+29/−21 lines, 6 files
Files
- dingo-core.cabal +1/−1
- src/Dingo/Internal/Callback.hs +3/−3
- src/Dingo/Internal/Server/State.hs +2/−2
- src/Dingo/Internal/Server/Wai.hs +4/−4
- src/Dingo/Internal/SessionTypes.hs +8/−8
- src/Dingo/Internal/TypeableShim.hs +11/−3
dingo-core.cabal view
@@ -1,5 +1,5 @@ Name: dingo-core-Version: 0.0.3.1+Version: 0.0.3.2 Synopsis: Dingo is a Rich Internet Application platform based on the Warp web server. Description: Dingo is a Rich Internet Application platform based on the Warp web server. It allows you to write code which looks very much like regular GUI code and have it work in the browser.
src/Dingo/Internal/Callback.hs view
@@ -12,11 +12,11 @@ import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) import Data.Aeson (ToJSON(..))-import Data.Typeable (typeOf, typeRepKey) import Dingo.Internal.Base (CallbackId, WidgetId, Command(..)) import Dingo.Internal.CallbackTypes import Dingo.Internal.Html (mkHeadMerge) import qualified Dingo.Internal.Session as S+import Dingo.Internal.TypeableShim (getTypeId) import Dingo.Internal.WidgetTypes -- Register a callback.@@ -35,8 +35,8 @@ -- Add all the commands from the widget construction. augmentState callbackState -- Register widget type if necessary.- widgetTypeRepKey <- liftIO $ typeRepKey $ typeOf w- registeredWidgetType <- lift $ S.registerWidgetType $ widgetTypeRepKey+ widgetTypeId <- liftIO $ getTypeId w+ registeredWidgetType <- lift $ S.registerWidgetType $ widgetTypeId -- Register resource bundles and perform head merges if necessary. when registeredWidgetType $ do -- Which resources does this widget require?
src/Dingo/Internal/Server/State.hs view
@@ -114,8 +114,8 @@ getSessionId = fst -- Handle a callback.-handleCallback :: ServerState -> ClientSession -> CallbackId -> HashMap WidgetId Value -> IO ()-handleCallback serverState clientSession callbackId widgetStates = do+handleCallback :: ClientSession -> CallbackId -> HashMap WidgetId Value -> IO ()+handleCallback clientSession callbackId widgetStates = do -- Get the session reference. let clientSessionRef = snd clientSession session <- readIORef clientSessionRef
src/Dingo/Internal/Server/Wai.hs view
@@ -110,8 +110,8 @@ fmap (\i -> (i,v)) $ parseOnlyText widgetIdParser k -- Callback server part.-callback :: ServerState -> Request -> ClientSession -> Text -> Iteratee ByteString IO Response-callback serverState request clientSession callbackIdStr =+callback :: Request -> ClientSession -> Text -> Iteratee ByteString IO Response+callback request clientSession callbackIdStr = handle $ parseOnlyText callbackIdParser callbackIdStr where handle :: Maybe CallbackId -> Iteratee ByteString IO Response@@ -123,7 +123,7 @@ -- Get the state update portion of the form data. let stateUpdates = convertStateUpdates stateJson -- Handle the callback- liftIO $ handleCallback serverState clientSession callbackId stateUpdates+ liftIO $ handleCallback clientSession callbackId stateUpdates return emptyOKResponse -- Long polling handler.@@ -179,6 +179,6 @@ case pathInfo request of [] -> return $ indexResponse serverState responseHeaders ["poll"] -> poll serverState clientSession- ["callback",cid] -> callback serverState request clientSession cid+ ["callback",cid] -> callback request clientSession cid ("bundles":bundlePath) -> serveBundle clientSession bundlePath _ -> return forbiddenResponse
src/Dingo/Internal/SessionTypes.hs view
@@ -24,18 +24,18 @@ import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.State.Strict (StateT, runStateT) import Data.ByteString (ByteString)-import Data.HashSet (HashSet)-import qualified Data.HashSet as S import Data.Label (mkLabels, (:->)) import qualified Data.Label as L import Data.Label.PureM (gets, puts, modify) import Data.Map (Map) import qualified Data.Map as M import Data.Monoid (mappend)+import Data.Set (Set)+import qualified Data.Set as S import Data.Text (Text) import Dingo.Internal.Base (CallbackId, WidgetId, succCallbackId, succWidgetId, zeroCallbackId, zeroWidgetId) import Dingo.Internal.ResourceBundle.Internal (ResourceBundle, ResourceBundleSet, elemResourceBundleSet, findResourceInBundleSet, resourceBundleSetFromList)-import Dingo.Internal.TypeableShim (TypeRepKey)+import Dingo.Internal.TypeableShim (TypeId) import Dingo.Internal.WidgetSet (WidgetSet, emptyWidgetSet, setWidgetState, getWidgetState) import Dingo.Internal.WidgetTypes (Widget) @@ -46,7 +46,7 @@ , _widgetCounter :: WidgetId , _sessionCallbacks :: Map CallbackId c , _widgetSet :: WidgetSet- , _widgetTypeSet :: HashSet TypeRepKey+ , _widgetTypeSet :: Set TypeId , _resourceBundleSet :: ResourceBundleSet } @@ -111,10 +111,10 @@ -- Check if a widget type is registered in the session, -- and register it if not. Returns -- true iff the bundle was not previously registered.-registerWidgetType :: (Monad m, Functor m) => TypeRepKey -> SessionT c m Bool-registerWidgetType widgetTypeRepKey = SessionT $ do- e <- fmap (S.member widgetTypeRepKey) $ gets widgetTypeSet- unless e $ modify widgetTypeSet $ S.insert widgetTypeRepKey+registerWidgetType :: (Monad m, Functor m) => TypeId -> SessionT c m Bool+registerWidgetType widgetTypeId = SessionT $ do+ e <- fmap (S.member widgetTypeId) $ gets widgetTypeSet+ unless e $ modify widgetTypeSet $ S.insert widgetTypeId return $ not e -- Register a resource bundle in the session. Returns
src/Dingo/Internal/TypeableShim.hs view
@@ -1,9 +1,17 @@ module Dingo.Internal.TypeableShim- ( TypeRepKey+ ( TypeId+ , getTypeId ) where #if __GLASGOW_HASKELL__ >= 720-import Data.Typeable (TypeRepKey)+import Data.Typeable (Typeable, TypeRep, typeOf)+newtype TypeId = TypeId TypeRep deriving (Eq, Ord, Show)+getTypeId :: Typeable a => a -> IO TypeId+getTypeId a = return $ TypeId $ typeOf a #else-type TypeRepKey = Int+import Data.Typeable (Typeable, typeOf, typeRepKey)+import Control.Monad (liftM)+newtype TypeId = TypeId Int deriving (Eq, Ord, Show)+getTypeId :: Typeable a => a -> IO TypeId+getTypeId a = liftM TypeId $ typeRepKey $ typeOf a #endif