classy-miso (empty) → 0.0.0.1
raw patch · 7 files changed
+609/−0 lines, 7 filesdep +aesondep +basedep +bifunctorssetup-changed
Dependencies added: aeson, base, bifunctors, classy-miso, containers, lens, megaparsec, miso, network-uri, rfc, url
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- app/Main.hs +6/−0
- classy-miso.cabal +92/−0
- src/Miso/Classy.hs +368/−0
- src/Miso/Classy/App.hs +109/−0
- test/Spec.hs +2/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Robert Fischer (c) 2018++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Robert Fischer nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import RFC.Prelude++main :: IO ()+main = return ()
+ classy-miso.cabal view
@@ -0,0 +1,92 @@+name: classy-miso+version: 0.0.0.1+description: Please see the README on Github at <https://github.com/RobertFischer/Classy-Miso#README.md>+homepage: https://github.com/RobertFischer/Classy-Miso#README.md+bug-reports: https://github.com/RobertFischer/Classy-Miso#README.md+author: Robert Fischer+maintainer: smokejumperit+stack@gmail.com+copyright: Robert Fischer+license: BSD3+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10+category: web+synopsis: Typeclass based support for Miso, the Tasty Web Framework for Haskell.++source-repository head+ type: git+ location: https://github.com/RobertFischer/Classy-Miso++Flag Development+ Description: Turn on errors for warnings+ Default: False+ Manual: True++library+ hs-source-dirs:+ src+ build-depends:+ base >= 4.7 && <5+ , miso >= 0.15.0.0 && < 0.16+ , rfc >= 0.0.0.25 && < 0.1+ , megaparsec >= 6.4.0.0 && < 7+ , lens >= 4.15.0.0 && < 5+ , network-uri >= 2.6.1.0 && < 2.7+ , containers >= 0.5.7.1 && < 0.6+ , url >= 2.1.3 && < 2.2+ if impl(ghcjs)+ build-depends: aeson+ , bifunctors+ cpp-options: -DCLIENT -DGHCJS_BROWSER -DBROWSER+ default-language: Haskell2010+ default-extensions: RebindableSyntax+ , MonadFailDesugaring+ , MultiParamTypeClasses+ , TypeFamilies+ , ExistentialQuantification+ , FlexibleContexts+ , FlexibleInstances+ , RankNTypes+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans+ ghc-options: -fno-max-relevant-binds -fprint-potential-instances -Wno-missing-monadfail-instances+ ghc-options: -fno-warn-name-shadowing -fno-warn-tabs -Wall-missed-specialisations -Wnoncanonical-monad-instances+ ghc-options: -Wnoncanonical-monadfail-instances -Wimplicit-prelude -Wmissing-exported-signatures -Widentities+ if flag(Development)+ ghc-options: -Werror -dcore-lint -dcmm-lint+ exposed-modules: Miso.Classy+ , Miso.Classy.App++executable classy-miso-demo+ main-is: Main.hs+ hs-source-dirs:+ app+ ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-orphans+ ghc-options: -fno-max-relevant-binds -fprint-potential-instances -Wno-missing-monadfail-instances+ ghc-options: -fno-warn-name-shadowing -fno-warn-tabs -Wall-missed-specialisations -Wnoncanonical-monad-instances+ ghc-options: -Wnoncanonical-monadfail-instances -Wimplicit-prelude -Wmissing-exported-signatures -Widentities+ if flag(Development)+ ghc-options: -Werror -dcore-lint -dcmm-lint+ build-depends:+ base >=4.7 && <5+ , classy-miso+ , miso+ , rfc+ default-language: Haskell2010+ default-extensions: RebindableSyntax+ , MonadFailDesugaring+ , MultiParamTypeClasses+ , TypeFamilies+ , RankNTypes++test-suite ghcjs-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -Wall -Wcompat -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , classy-miso+ , miso+ , rfc+ default-language: Haskell2010
+ src/Miso/Classy.hs view
@@ -0,0 +1,368 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilyDependencies #-}+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UnicodeSyntax #-}+#if !MIN_VERSION_base(4,10,0)+{-# OPTIONS_GHC -fno-warn-deprecations #-}+#endif++module Miso.Classy+ ( Component(..)+ , update'+ , WrappedComponent+ , wrapComponent+ , mapWrappedComponent+ , addSubcomponent+ , WrappedAction(..)+ , RouteParser+ , ClassyEffect+ , WrappedEffect+ , ClassyTransition+ , ClassySub+ , ClassySink+ , WrappedView+ , WrappedSub+ , WrappedSink+ , wrapAction+ , wrapSub+ , routeToURI+ , toRoutePath+ , getCurrentURI+ , parseCurrentURI+ , RoutePath+ , actionToSub+ , actionToWrappedSub+ , viewSub+ , viewSubs+ , viewSubBy+ , viewSubsBy+ , emptyView+ , module Miso+ , module Network.URI+ , module RFC.Miso.String+ ) where++import Control.Lens hiding ( view )+import Data.Map.Strict ( Map )+import qualified Data.Map.Strict as Map+import Data.Typeable+import Miso hiding ( App (..), getCurrentURI )+import qualified Miso.Html as Html+import Network.URI ( URI (..), parseURI )+import qualified Network.URL as URL+import RFC.Miso.String+import RFC.Prelude hiding ( init )++-- Need the ability to compare proxies for equivalence+#if MIN_VERSION_base(4,10,0)+import Type.Reflection ( eqTypeRep )++eqProxy :: Proxy a -> Proxy b -> Maybe (a :~: b)+eqProxy a b = eqTypeRep (typeRep a) (typeRep b)+#else+-- | Hand-rolled and dangerous implementation of 'eqTypeRep'.+eqProxy :: (Typeable a, Typeable b) => Proxy a -> Proxy b -> Maybe (a :~: b)+eqProxy a b+ | typeRep a == typeRep b = Just undefined+ | otherwise = Nothing+#endif++{-# ANN module ("HLint: ignore Use fewer imports"::String) #-}++-- | A 'View' where we wrap up the action type as a 'WrappedAction'.+type WrappedView = View WrappedAction++-- | An 'Effect' where we wrap up the action type as a 'WrappedAction'.+type WrappedEffect model = Effect WrappedAction model++-- | A 'Sink' where we wrap up the action type as a 'WrappedAction'.+type WrappedSink = WrappedAction -> IO ()++-- | A 'Sub' where we wrap up the action type as a 'WrappedSub'.+type WrappedSub = WrappedSink -> IO ()++-- | Handy alias specifying the 'Effect' in terms of type families.+type ClassyEffect model = Effect (Action model) model++-- | Handy alias specifying the 'Transition' in terms of type families.+type ClassyTransition model = Transition (Action model) model++-- | Handy alias specifying the 'Sink' in terms of type families.+type ClassySink model = Action model -> IO ()++-- | Handy alias specifying the 'Sub' in terms of type families.+type ClassySub model = ClassySink model -> IO ()++-- | Wraps the concept of th e+class (Eq model, Typeable model, Typeable (Action model)) => Component model where+ {-# MINIMAL init, view, subcomponents, (update|transition) #-}++ -- | The actions for this component, such as those returned in an 'Effect'+ type Action model = action | action -> model++ -- | Defines the initial arguments that the component expects to receive.+ type InitArgs model = initargs | initargs -> model++ init :: InitArgs model → IO model -- ^ Initialize the model+ view :: model -> View (Action model) -- ^ Render the model into a VDOM-friendly structure++ subcomponents :: ALens' model [WrappedComponent] -- ^ Holds onto all the subcomponents++ routeParser :: model -> RouteParser -- ^ Provides a parser that defines the route for this model+ routeParser _ _ = fail "Model is not a route"+ {-# INLINE routeParser #-}++ -- | Implement this if you want to use the classic way to update.+ update :: Action model -> model -> ClassyEffect model+ update = fromTransition . transition+ {-# INLINE update #-}++ -- | Implement this if you want to use the 'Transition'-based way to update.+ transition :: Action model -> ClassyTransition model ()+ transition = toTransition . update+ {-# INLINE transition #-}++ -- | Whether or not this action is really for this model. By default, we accept all actions. But, if you've+ -- got multiple components of the same type, you may need to be more picky.+ acceptAction :: Action model -> model -> Bool+ acceptAction _ _ = True+ {-# INLINE acceptAction #-}++-- | Handy method for the common case when you can pass your args down to your subcomponents.+addSubcomponent :: (Component model, Component sub) => InitArgs model -> model -> (InitArgs model -> IO (InitArgs sub)) -> IO model+addSubcomponent parentArgs parent argPicker = addSub <$> (subArgs >>= init)+ where+ subArgs = argPicker parentArgs+ initSubs = parent^.(cloneLens subcomponents)+ addSub newSub = parent & (cloneLens subcomponents) .~ (wrapComponent newSub:initSubs)++-- | For the component itself, and then recursively for all the subcomponents, this attempts to cast+-- the action (unwrapped from 'WrappedAction') to the relevant type for that component.+-- If that works, we calls 'update' on that component.+update' :: (Component model) => WrappedAction -> model -> WrappedEffect model+update' wrapped@(WrappedAction action) initModel =+ Effect finalModel allEffects+ where+ (finalModel, allEffects) = (foldedModel, foldedEffects)+ Effect foldedModel foldedEffects =+ foldr foldImpl initEffect (initModel^.(cloneLens subcomponents))+ foldImpl (WrappedComponent (_,subcomp)) (Effect roundModel roundEffects) =+ let result = update' wrapped subcomp in+ let Effect wrappedModel wrappedEffects = result &+ bimap+ id+ (\subModel -> roundModel & (cloneLens subcomponents) %~ ((:) (WrappedComponent (Proxy,subModel))))+ in+ Effect wrappedModel (wrappedEffects <> roundEffects)+ initEffect =+ case cast action of+ Nothing -> noEff initModel+ Just myAction ->+ if acceptAction myAction initModel then+ bimap wrapAction id $ update myAction initModel+ else+ noEff initModel+{-# INLINABLE update' #-}++-- | The function for processing routes from route paths. It will consume the current+-- 'RoutePath', and (if it successfully parsed), it returns the component that handles the route.+type RouteParser = forall m. MonadFail m => RoutePath -> m WrappedComponent++-- | A wrapper around components that hides the existential quantification.+data WrappedComponent = forall child. Component child ⇒ WrappedComponent (Proxy child, child)+instance Eq WrappedComponent where+ (==) (WrappedComponent left) (WrappedComponent right) =+ maybe False (left ==) (cast right)+ {-# INLINE (==) #-}++-- | Smart constructor for 'WrappedComponent'.+wrapComponent :: Component child => child -> WrappedComponent+wrapComponent child = WrappedComponent (Proxy, child)+{-# INLINE wrapComponent #-}++-- | Allows you to effectively extract the component, but note that the type of the+-- wrapped component can't escape its scope.+mapWrappedComponent :: (forall model. Component model => model -> a) -> WrappedComponent -> a+mapWrappedComponent f (WrappedComponent(_,it)) = f it+{-# INLINE mapWrappedComponent #-}++-- | A wrapper around actions, such as those returned in an 'Effect', which+-- hides the existential quantification.+data WrappedAction = forall child. Component child => WrappedAction (Action child)++-- | Utility function for wrapping up an action into a 'WrappedAction'+wrapAction :: Component model => Action model -> WrappedAction+wrapAction = WrappedAction+{-# INLINE wrapAction #-}++-- | Utility method for converting an action into a 'Sub'+actionToSub :: Action model -> Sub (Action model)+actionToSub action sink = sink action+{-# INLINE actionToSub #-}++-- | Utility function for wrapping up a 'Sub' into a 'WrappedSub'+wrapSub :: Component model => Sub (Action model) -> WrappedSub+wrapSub sub sink = sub (sink . wrapAction)+{-# INLINE wrapSub #-}++-- | Ties together 'actionToSub' and 'wrapSub' for you,+-- so you can go all the way from an action to a 'WrappedSub'.+actionToWrappedSub :: Component model => Action model -> WrappedSub+actionToWrappedSub = wrapSub . actionToSub+{-# INLINE actionToWrappedSub #-}++-- | A single segment of a route (a piece between slashes in the URI fragment)+type RouteSegment = StrictText++-- | The value of the query section of a route+type RouteQuery = Map StrictText [StrictText]++-- | The full path of the route. The third URL is the "base URI",+-- and does not necessarily contain the 'RouteSegment' and the+-- 'RouteQuery' pieces.+type RoutePath = ([RouteSegment], RouteQuery, URI)++-- | Generates a URI from the route path by merging the 'RouteQuery' into the 'uriQuery'+-- and the '[RouteSegment]' into the 'uriFragment'.+routeToURI :: RoutePath -> URI+routeToURI (segs, qry, uri) =+ uri+ { uriQuery = '?':query+ , uriFragment = '#':frag+ }+ where+ encodeString :: ConvertibleStrings a String => Bool -> a -> String -- Second argument is: "Is this a query string?"+ encodeString spaceToPlus = URL.encString spaceToPlus URL.ok_param . cs+ query :: String+ query = intercalate "&" . pairsToTerms $ Map.toList qry+ pairsToTerms [] = []+ pairsToTerms ((key,[]):rest) = (encodeString True key) : pairsToTerms rest+ pairsToTerms ((key,([val])):rest) = (encodeString True key <> "=" <> (encodeString True val)) : pairsToTerms rest+ pairsToTerms ((key,vals):rest) = (encodeString True key <> "=" <> intercalate "," (encodeString True <$> vals)) : pairsToTerms rest+ frag :: String+ frag = intercalate "/" (segToPath <$> segs)+ segToPath :: RouteSegment -> String+ segToPath = encodeString False+{-# INLINABLE routeToURI #-}+++-- | Parses a 'URI' into a 'RoutePath'+toRoutePath :: URI -> RoutePath+toRoutePath uri@URI{uriFragment,uriQuery} =+ ( pathToSegments . parseHash $ uriFragment+ , parseQuery uriQuery+ , uri+ )+ where+ decodeString :: String -> StrictText+ decodeString str = cs . fromMaybe str . URL.decString True $ str+ pathToSegments :: String -> [RouteSegment]+ pathToSegments "" = []+ pathToSegments ('/':rest) = pathToSegments rest+ pathToSegments path = (decodeString start) : pathToSegments rest+ where+ (start,rest) = splitOnSlash path+ splitOnSlash "" = ("","")+ splitOnSlash ('/':content) = splitOnSlash content+ splitOnSlash content =+ case span ('/' /=) content of+ ([],[]) -> ("","")+ ([], _:theRest) -> splitOnSlash theRest+ (theStart, []) -> (theStart, "")+ (theStart, _:theRest) -> (theStart, theRest)+ parseHash ('#':rest) = parseHash rest+ parseHash ('!':rest) = parseHash rest+ parseHash ('/':rest) = parseHash rest+ parseHash hash = hash+ parseQuery ('?':rest) = parseQuery rest+ parseQuery query =+ case URL.importParams query of+ Nothing ->+ Map.empty+ Just pairs ->+ fmap (second listify) pairs &+ Map.fromListWith (++) &+ Map.map sort &+ Map.map (fmap cs) &+ Map.mapKeys cs+ listify :: String -> [String]+ listify "" = []+ listify (',':val) = listify val+ listify val = start : listify rest+ where+ (start,rest) = splitOnComma val+ splitOnComma "" = ("","")+ splitOnComma (',':content) = splitOnComma content+ splitOnComma (' ':content) = splitOnComma content+ splitOnComma content =+ case span (',' /=) content of+ ([], []) -> ("", "")+ ([], _:theRest) -> splitOnComma theRest+ (theStart, []) -> (theStart, "")+ (theStart, _:theRest) -> (theStart, theRest)+{-# INLINABLE toRoutePath #-}++-- | Retrieves the current location of the window from "window.location.href".+foreign import javascript safe "$r = (window && window.location && window.location.href) || '';"+ getWindowLocationHref :: IO MisoString++-- | Gets the current URI.+getCurrentURI :: (MonadIO m, MonadFail m) => m URI+getCurrentURI = do+ href <- fromMisoString <$> liftIO getWindowLocationHref+ case parseURI href of+ Nothing -> fail $ "Co uld not parse URI from window.location: " <> href+ Just uri -> return uri+{-# INLINE getCurrentURI #-}++-- | Utility method to parse the current URI.+parseCurrentURI :: (MonadIO m) => m RoutePath+parseCurrentURI = toRoutePath <$> liftIO getCurrentURI+{-# INLINE parseCurrentURI #-}++-- | View a particular subcomponent by specifying a test. For the first (leftmost) subcomponent+-- that returns 'True', we will return their view. Failing that, we return an+-- empty (but defined) view.+viewSubBy :: (Component model) => model -> (WrappedComponent -> Bool) -> WrappedView+viewSubBy parent subTest = fromMaybe emptyView . safeHead $ viewSubsBy parent subTest+{-# INLINE viewSubBy #-}++-- | View a particular subcomponent by specifying its type. For the first (leftmost) subcomponent+-- whose type is equal to the given type, we will return their view. Failing that, we+-- return an empty (but defined) view.+viewSub :: (Component model, Component sub) => model -> Proxy sub -> WrappedView+viewSub parent subType = viewSubBy parent (wrappedComponentPxyEq subType)+{-# INLINE viewSub #-}++-- | View subcomponents by a given test. For every subcomponent that returns 'True', we will+-- include their 'WrappedView' in the resulting list.+viewSubsBy :: (Component model) => model -> (WrappedComponent -> Bool) -> [WrappedView]+viewSubsBy parent test =+ toWrappedView <$> filter test targets+ where+ targets = (wrapComponent parent : parent^.(cloneLens subcomponents))+ toWrappedView :: WrappedComponent -> WrappedView+ toWrappedView (WrappedComponent(_,sub)) = WrappedAction <$> view sub+{-# INLINE viewSubsBy #-}++-- | View subcomponents by specifying their type. For every subcomponent of whose type+-- is equal to the given type, we will include their 'WrappedView' in the resulting list.+viewSubs :: (Component model, Component sub) => model -> Proxy sub -> [WrappedView]+viewSubs parent subType = viewSubsBy parent (wrappedComponentPxyEq subType)+{-# INLINE viewSubs #-}++-- | Test that a 'WrappedComponent' is equal to a given type.+wrappedComponentPxyEq :: (Component target) => Proxy target -> WrappedComponent -> Bool+wrappedComponentPxyEq targetPxy (WrappedComponent(pxy,_)) = isJust $ eqProxy targetPxy pxy+{-# INLINE wrappedComponentPxyEq #-}++-- | A definition of an empty view, which has no impact on how the screen is rendered.+emptyView :: View anything+emptyView = Html.text ""+{-# INLINE emptyView #-}
+ src/Miso/Classy/App.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE UnicodeSyntax #-}++module Miso.Classy.App+ ( MisoApp(..)+ , appToRecord+ , startClientApp+ , startIsoClientApp+ , ViewSpec(..)+ , vsRoutePath+ , specToView+ , defaultSubscriptions+ , module Miso.Classy+ ) where++import Control.Lens hiding ( view )+import Miso hiding ( App (..) )+import qualified Miso+import Miso.Classy+import Network.URI ( URI (..), parseURI )+import RFC.Prelude++class (Component model) => MisoApp model where+ createApp :: InitArgs model -> IO model+ initialAction :: model -> Action model+ notFoundView :: model -> WrappedComponent+ viewSpec :: ALens' model ViewSpec++ subscriptions :: model -> [Sub WrappedAction]+ subscriptions = const defaultSubscriptions+ {-# INLINE subscriptions #-}++instance (MisoApp model) => HasURI model where+ lensURI :: Lens' model URI+ lensURI = lens+ (\model -> model^.(cloneLens viewSpec) & vsUri)+ (\model newUri -> model & (cloneLens viewSpec) .~+ (let theRoutePath = toRoutePath newUri in+ fromMaybe+ (ViewSpec (notFoundView model, theRoutePath))+ (applyRoute model theRoutePath)+ )+ )+ {-# INLINE lensURI #-}++-- | These are the default subscriptions that we automatically connect to.+defaultSubscriptions :: [Sub WrappedAction]+defaultSubscriptions = []+{-# INLINE defaultSubscriptions #-}++applyRoute :: (MisoApp model) => model -> RoutePath -> Maybe ViewSpec+applyRoute model routePath =+ foldr foldImpl (parseToVs model) subs+ where+ parseToVs :: forall c. Component c => c -> Maybe ViewSpec+ parseToVs it = (\result -> ViewSpec (result, routePath)) <$> routeParser it routePath+ foldImpl wrapped rest = mapWrappedComponent parseToVs wrapped <|> rest+ subs = model^.(cloneLens subcomponents)+{-# INLINE applyRoute #-}++-- | Converts a 'MisoApp' into a 'Miso.App' record with reasonable defaults+-- for 'Miso.events' and 'Miso.mountPoint', and everything else derived+-- from the 'MisoApp' class.+appToRecord :: (MisoApp model) => model -> Miso.App model WrappedAction+appToRecord model = Miso.App+ { Miso.model = model+ , Miso.update = update'+ , Miso.view = fmap WrappedAction . view+ , Miso.subs = subscriptions model+ , Miso.events = Miso.defaultEvents+ , Miso.initialAction = WrappedAction $ initialAction model+ , Miso.mountPoint = Nothing+ }+{-# INLINE appToRecord #-}++-- | Starts an app with the default 'appToRecord' conversion and without+-- expecting there to be a DOM in existence.+startClientApp :: (MisoApp model, MonadIO m) => InitArgs model -> m ()+startClientApp args = liftIO $ do+ app <- createApp args+ Miso.startApp $ appToRecord app+{-# INLINE startClientApp #-}++-- | Starts an app with the default 'appToRecord' conversion, and assuming+-- that there is an isomorphic DOM in existence already.+startIsoClientApp :: (MisoApp model, MonadIO m) => InitArgs model -> m ()+startIsoClientApp args = liftIO $ do+ app <- createApp args+ Miso.startApp $ appToRecord app+{-# INLINE startIsoClientApp #-}++-- | This contains the information necessary to render a view.+newtype ViewSpec = ViewSpec (WrappedComponent, RoutePath) deriving (Eq)++-- | Get the route path which matched for the 'ViewSpec'+vsRoutePath :: ViewSpec -> RoutePath+vsRoutePath (ViewSpec (_,rp)) = rp+{-# INLINE vsRoutePath #-}++vsUri :: ViewSpec -> URI+vsUri (ViewSpec (_,(_,_,uri))) = uri+{-# INLINE vsUri #-}++-- | Renders a view based on the viewspec+specToView :: ViewSpec -> View WrappedAction+specToView (ViewSpec (wrapped,_)) = mapWrappedComponent (fmap WrappedAction . view) wrapped+{-# INLINE specToView #-}
+ test/Spec.hs view
@@ -0,0 +1,2 @@+main :: IO ()+main = putStrLn "Test suite not yet implemented"