rfc 0.0.0.23 → 0.0.0.24

raw patch · 3 files changed

+33/−15 lines, 3 files

Files

• rfc.cabal +1/−1
• src/RFC/Miso/Routing.hs +30/−14
• src/RFC/Prelude.hs +2/−0

@@ -1,5 +1,5 @@ name:                rfc-version:             0.0.0.23+version:             0.0.0.24 synopsis:            Robert Fischer's Common library description:         An enhanced Prelude and various utilities for Aeson, Servant, PSQL, and Redis that Robert Fischer uses. homepage:            https://github.com/RobertFischer/rfc#README.md

@@ -42,7 +42,7 @@     listify ""  = []     listify val = [val] -parseCurrentURI :: IO (URIHash,URIQuery)+parseCurrentURI :: IO RoutingURI parseCurrentURI = parseURI <$> getCurrentURI  data ViewSpec parentModel parentAction = ViewSpec (parentModel -> View parentAction, RoutingURI)@@ -50,20 +50,22 @@ instance Eq (ViewSpec model action) where   (==) (ViewSpec(_,left)) (ViewSpec(_,right)) = left == right -class (Typeable model) => RouteConfig model action+class RouteConfig model action       | model -> action, action -> model   where     routeUpdate   :: model -> action -> Effect action model     routeView     :: model -> View action-    runRoute      :: RoutingURI -> Maybe (Effect action model)+    runRoute      :: model -> RoutingURI -> Maybe (Effect action model) -class (RouteConfig model action) => RouteConvert parentModel parentAction model action+class (RouteConfig model action, ViewSpecContainer parentModel parentAction)+      => RouteConvert parentModel parentAction model action       | parentAction -> parentModel, parentModel -> parentAction   where     wrapAction    :: action -> model -> parentAction     unwrapAction  :: parentAction -> model -> Maybe action     wrapModel     :: parentModel -> model -> parentModel     unwrapModel   :: parentModel -> model+     wrapEffect    :: parentModel -> Effect action model -> Effect parentAction parentModel     wrapEffect parentModel (Effect model childIOs) =       Effect@@ -72,11 +74,13 @@      wrappedRunRoute :: Proxy model -> WrappedRun parentModel parentAction     wrappedRunRoute _ uriPair currentParentModel = do-        childEffect <- runRoute uriPair-        return (effectWrapper childEffect, ViewSpec (view, uriPair))+        childEffect <- runRoute childSeed uriPair+        return $ effectWrapper childEffect (ViewSpec (view, uriPair))       where-        effectWrapper :: Effect action model -> Effect parentAction parentModel-        effectWrapper = wrapEffect currentParentModel+        childSeed :: model+        childSeed = unwrapModel currentParentModel+        effectWrapper :: Effect action model -> ViewSpec parentModel parentAction -> Effect parentAction parentModel+        effectWrapper childEffect viewSpec = wrapEffect (setViewSpec currentParentModel viewSpec) childEffect         view :: parentModel -> View parentAction         view parentModel = fmap (\action -> wrapAction action childModel) $ routeView childModel           where@@ -92,28 +96,40 @@         model :: model         model = unwrapModel parentModel +class ViewSpecContainer parentModel parentAction where+  setViewSpec :: parentModel -> ViewSpec parentModel parentAction -> parentModel+  getViewSpec :: parentModel -> ViewSpec parentModel parentAction++renderViewSpec :: (ViewSpecContainer parentModel parentAction) => parentModel -> View parentAction+renderViewSpec container =  renderFunc container+  where+    (ViewSpec (renderFunc,_)) = getViewSpec container+ type WrappedRun parentModel parentAction =-  RoutingURI -> parentModel -> Maybe (Effect parentAction parentModel, ViewSpec parentModel parentAction)+  RoutingURI -> parentModel -> Maybe (Effect parentAction parentModel)  type WrappedUpdate parentModel parentAction = parentModel -> parentAction -> Effect parentAction parentModel  data RoutingTable parentModel parentAction =   RoutingTable [(WrappedRun parentModel parentAction, WrappedUpdate parentModel parentAction)] +newRoutingTable :: RoutingTable parentModel parentAction+newRoutingTable = RoutingTable []+ addRoute :: (RouteConvert parentModel parentAction model action) =>-  RoutingTable parentModel parentAction -> Proxy model -> RoutingTable parentModel parentAction-addRoute (RoutingTable table) pxy =+  Proxy model -> RoutingTable parentModel parentAction -> RoutingTable parentModel parentAction+addRoute pxy (RoutingTable table) =   RoutingTable $ (wrappedRunRoute pxy, wrappedRouteUpdate pxy):table -runTable ::+runTable :: (ViewSpecContainer parentModel parentAction) =>   RoutingTable parentModel parentAction ->   (parentModel -> View parentAction) ->   RoutingURI ->   parentModel ->-  (Effect parentAction parentModel, ViewSpec parentModel parentAction)+  Effect parentAction parentModel runTable (RoutingTable routes) notFoundView routingURI parentModel =     case safeHead $ catMaybes routeRunResults of-      Nothing -> (noEff parentModel, ViewSpec (notFoundView, routingURI))+      Nothing -> (noEff $ setViewSpec parentModel (ViewSpec (notFoundView, routingURI)))       Just results -> results   where     routeRunResults = map (\run -> run routingURI parentModel) $ map fst routes

@@ -55,5 +55,7 @@ safeHead []    = Nothing safeHead (x:_) = Just x +foldl :: MonoFoldable mono => (a -> Element mono -> a) -> a -> mono -> a+foldl = foldl'  type Boolean = Bool -- I keep forgetting which Haskell uses....