on master help sign in
Legacy compiler build fixes
commitcdd82771c51ae9dcc25844cd136d9e5f212e1797 authorLuigy Leon <luigy.leon@obsidian.systems> dateSun 21 Oct 2018, 20:49 (8 years ago) parentbe93198
4 files changed+21−3
lib/backend/src/Obelisk/Backend.hs+1 lib/frontend/src/Obelisk/Frontend.hs+1 lib/route/src/Obelisk/Route.hs+1 lib/route/src/Obelisk/Route/Frontend.hs+18−3
lib/backend/src/Obelisk/Backend.hs+1
@@ -29,6 +29,7 @@ import Data.Default (Default (..))
2929import Data.Dependent.Sum
3030import Data.Functor.Sum
3131import Data.Functor.Identity
32+import Data.Monoid ((<>))
3233import Data.Text (Text)
3334import qualified Data.Text as T
3435import Data.Text.Encoding
lib/frontend/src/Obelisk/Frontend.hs+1
@@ -31,6 +31,7 @@ import Data.ByteString (ByteString)
3131import Data.Dependent.Sum (DSum (..))
3232import Data.Functor.Sum
3333import Data.IORef
34+import Data.Monoid ((<>))
3435import GHCJS.DOM hiding (bracket, catch)
3536import GHCJS.DOM.Document
3637import GHCJS.DOM.Node
lib/route/src/Obelisk/Route.hs+1
@@ -103,6 +103,7 @@ import Data.List.NonEmpty (NonEmpty (..))
103103import Data.Map (Map)
104104import qualified Data.Map as Map
105105import Data.Maybe
106+import Data.Monoid ((<>))
106107import Data.Set (Set)
107108import qualified Data.Set as Set
108109import Data.Some (Some)
lib/route/src/Obelisk/Route/Frontend.hs+18−3
@@ -49,7 +49,7 @@ import Obelisk.Route
4949
5050import Control.Category (Category (..), (.))
5151import Control.Category.Cartesian
52−import Control.Lens hiding (Bifunctor, bimap, universe)
52+import Control.Lens hiding (Bifunctor, bimap, universe, element)
5353import Control.Monad.Fix
5454import Control.Monad.Primitive
5555import Control.Monad.Ref
@@ -95,7 +95,11 @@ instance Monad m => Routed t r (RoutedT t r m) where
9595 askRoute = RoutedT ask
9696
9797newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }
98− deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, HasJSContext, MonadIO, MonadReflexCreateTrigger t, HasDocument)
98+ deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadIO, MonadReflexCreateTrigger t, HasDocument)
99+
100+instance HasJSContext m => HasJSContext (RoutedT t r m) where
101+ type JSContextPhantom (RoutedT t r m) = JSContextPhantom m
102+ askJSContext = lift askJSContext
99103
100104instance Prerender js m => Prerender js (RoutedT t r m) where
101105 prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
@@ -213,7 +217,18 @@ strictDynWidget_ f = RoutedT $ ReaderT $ \r -> do
213217 pure ()
214218
215219newtype SetRouteT t r m a = SetRouteT { unSetRouteT :: EventWriterT t (Endo r) m a }
216− deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, HasJSContext, MonadIO, MonadReflexCreateTrigger t, HasDocument, DomBuilder t)
220+ deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, MonadIO, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, MonadReflexCreateTrigger t, HasDocument)
221+
222+instance (MonadFix m, MonadHold t m, DomBuilder t m) => DomBuilder t (SetRouteT t r m) where
223+ type DomBuilderSpace (SetRouteT t r m) = DomBuilderSpace m
224+ element t cfg child = SetRouteT $ element t cfg $ unSetRouteT child
225+ inputElement = lift . inputElement
226+ textAreaElement = lift . textAreaElement
227+ selectElement cfg child = SetRouteT $ selectElement cfg $ unSetRouteT child
228+
229+instance HasJSContext m => HasJSContext (SetRouteT t r m) where
230+ type JSContextPhantom (SetRouteT t r m) = JSContextPhantom m
231+ askJSContext = lift askJSContext
217232
218233mapSetRouteT :: (forall x. m x -> n x) -> SetRouteT t r m a -> SetRouteT t r n a
219234mapSetRouteT f (SetRouteT x) = SetRouteT (mapEventWriterT f x)