diff --git a/deku-core/src/Deku/Core.purs b/deku-core/src/Deku/Core.purs index 3672c7f7..f4e2f3e0 100644 --- a/deku-core/src/Deku/Core.purs +++ b/deku-core/src/Deku/Core.purs @@ -125,7 +125,7 @@ cb = Cb <<< ((map <<< map) (const true)) prop' :: String -> String -> Attribute' prop' k v = mkEffectFn2 \e (DOMInterpret { setProp }) -> - runEffectFn3 setProp (Key k) (Value v) (toDekuElement e) + runEffectFn3 setProp (Key k) (Value v) (toDekuElement e) cb' :: String -> Cb -> Attribute' cb' k v = mkEffectFn2 \e (DOMInterpret { setCb }) -> @@ -156,12 +156,15 @@ unsafeAttribute unsafeAttribute = Attribute attributeAtYourOwnRisk :: forall e. String -> String -> Attribute e -attributeAtYourOwnRisk k v = unsafeAttribute $ mkEffectFn2 \e (DOMInterpret { setProp }) -> - runEffectFn3 setProp (Key k) (Value v) (toDekuElement e) +attributeAtYourOwnRisk k v = unsafeAttribute $ mkEffectFn2 + \e (DOMInterpret { setProp }) -> + runEffectFn3 setProp (Key k) (Value v) (toDekuElement e) -callbackWithCaution :: forall e. String -> (Event -> Effect Boolean) -> Attribute e -callbackWithCaution k v = unsafeAttribute $ mkEffectFn2 \e (DOMInterpret { setCb }) -> - runEffectFn3 setCb (Key k) (Cb v) (toDekuElement e) +callbackWithCaution + :: forall e. String -> (Event -> Effect Boolean) -> Attribute e +callbackWithCaution k v = unsafeAttribute $ mkEffectFn2 + \e (DOMInterpret { setCb }) -> + runEffectFn3 setCb (Key k) (Cb v) (toDekuElement e) -- | Construct a [data attribute](https://developer.mozilla.org/en-US/docs/Learn/HTML/Howto/Use_data_attributes). xdata :: forall e. String -> String -> Attribute e @@ -235,29 +238,31 @@ newtype DOMInterpret = DOMInterpret , bufferPortal :: BufferPortal , beamRegion :: BeamRegion } + derive instance Newtype DOMInterpret _ -collectUnsubs :: EffectFn1 PSR ( STArray.STArray Global ( Effect Unit ) ) -collectUnsubs = mkEffectFn1 \( PSR psr ) -> do +collectUnsubs :: EffectFn1 PSR (STArray.STArray Global (Effect Unit)) +collectUnsubs = mkEffectFn1 \(PSR psr) -> do unsubs <- liftST $ STArray.new - when ( not ( Array.null psr.unsubs ) ) do + when (not (Array.null psr.unsubs)) do void $ liftST $ STArray.pushAll psr.unsubs unsubs pure unsubs -disposeUnsubs :: EffectFn1 ( STArray.STArray Global ( Effect Unit ) ) Unit +disposeUnsubs :: EffectFn1 (STArray.STArray Global (Effect Unit)) Unit disposeUnsubs = mkEffectFn1 \unsubs -> do - runEffectFn1 Event.fastForeachThunkE =<< liftST ( STArray.unsafeFreeze unsubs ) + runEffectFn1 Event.fastForeachThunkE =<< liftST (STArray.unsafeFreeze unsubs) -- | Handles an optimized `Poll` by running the effect on each emitted value. Any resulting subscription gets written to -- | the given cleanup array. -pump :: forall a +pump + :: forall a . STArray.STArray Global (Effect Unit) -> Poll a -> EffectFn1 a Unit -> Effect Unit pump associations p eff = go p - + where handleEvent :: Event.Event a -> Effect Unit @@ -271,14 +276,14 @@ pump associations p eff = OnlyPure x -> runEffectFn2 Event.fastForeachE x eff OnlyPoll x -> do bang <- liftST $ Event.create - handleEvent ( UPoll.sample x bang.event ) + handleEvent (UPoll.sample x bang.event) bang.push identity PureAndEvent x y -> do - go ( OnlyPure x ) - go ( OnlyEvent y ) + go (OnlyPure x) + go (OnlyEvent y) PureAndPoll x y -> do - go ( OnlyPure x ) - go ( OnlyPoll y ) + go (OnlyPure x) + go (OnlyPoll y) newtype PSR = PSR { lifecycle :: Poll.Poll Unit @@ -286,31 +291,32 @@ newtype PSR = PSR , region :: StaticRegion , unsubs :: Array (Effect Unit) } + derive instance Newtype PSR _ newtype Nut = Nut (EffectFn2 PSR DOMInterpret Unit) instance Semigroup Nut where - append ( Nut a ) ( Nut b ) = + append (Nut a) (Nut b) = -- unrolled version of `fixed` Nut $ mkEffectFn2 \psr di -> do -- first `Nut` should not handle any unsubs, they may still be needed for later elements - runEffectFn2 a ( over PSR _ { unsubs = [] } psr ) di + runEffectFn2 a (over PSR _ { unsubs = [] } psr) di runEffectFn2 b psr di - + instance Monoid Nut where mempty = -- while we contribute no UI elements we still have to handle any unsubs created by our hooks Nut $ mkEffectFn2 \psr _ -> do unsubs <- runEffectFn1 collectUnsubs psr - - let + + let handleLifecycle :: EffectFn1 Unit Unit handleLifecycle = mkEffectFn1 \_ -> runEffectFn1 disposeUnsubs unsubs - pump unsubs ( un PSR psr ).lifecycle handleLifecycle + pump unsubs (un PSR psr).lifecycle handleLifecycle -- hooks @@ -398,8 +404,8 @@ useRefST a e f = Nut $ mkEffectFn2 \psr di -> do { event, push } <- liftST $ Event.create u <- Event.subscribe (Poll.sample e event) \i -> void $ liftST $ ST.write i r push identity - let Nut nut = f ( ST.read r ) - runEffectFn2 nut ( withUnsub u psr ) di + let Nut nut = f (ST.read r) + runEffectFn2 nut (withUnsub u psr) di useState' :: forall a. Hook ((a -> Effect Unit) /\ Poll a) useState' f = Nut $ mkEffectFn2 \psr di -> do @@ -436,58 +442,58 @@ dynOptions = { sendTo: \_ -> empty, remove: \_ -> empty } useDyn :: forall value . Poll (Tuple (Maybe Int) value) - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDyn p = useDynWith p dynOptions useDynAtBeginning :: forall value . Poll value - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDynAtBeginning b = useDynAtBeginningWith b dynOptions useDynAtBeginningWith :: forall value . Poll value -> DynOptions value - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDynAtBeginningWith e = useDynWith (map (Just 0 /\ _) e) useDynAtEnd :: forall value . Poll value - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDynAtEnd b = useDynAtEndWith b dynOptions useDynAtEndWith :: forall value . Poll value -> DynOptions value - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDynAtEndWith e = useDynWith (map (Nothing /\ _) e) useDynWith :: forall value - . Poll ( Tuple ( Maybe Int ) value ) + . Poll (Tuple (Maybe Int) value) -> DynOptions value - -> Hook ( DynControl value ) + -> Hook (DynControl value) useDynWith elements options cont = Nut $ mkEffectFn2 \psr di -> do - RegionSpan span <- liftST ( un StaticRegion ( un PSR psr ).region ).span + RegionSpan span <- liftST (un StaticRegion (un PSR psr).region).span lifecycle <- liftST Poll.create unsubs <- runEffectFn1 collectUnsubs psr - + let - handleElements :: EffectFn1 ( Tuple ( Maybe Int ) value ) Unit - handleElements = mkEffectFn1 \( Tuple initialPos value ) -> do + handleElements :: EffectFn1 (Tuple (Maybe Int) value) Unit + handleElements = mkEffectFn1 \(Tuple initialPos value) -> do Region eltRegion <- liftST $ runSTFn1 span initialPos region <- liftST $ runSTFn2 newStaticRegion eltRegion.begin eltRegion.bump eltSendTo <- liftST Poll.create let sendTo :: Poll Int sendTo = - Poll.merge [ options.sendTo value, eltSendTo.poll ] + Poll.merge [ options.sendTo value, eltSendTo.poll ] eltRemove <- liftST Poll.create - let + let remove :: Poll Unit remove = Poll.merge [ options.remove value, eltRemove.poll, lifecycle.poll ] @@ -496,14 +502,14 @@ useDynWith elements options cont = Nut $ mkEffectFn2 \psr di -> do let Nut nut = cont { value - , position : eltRegion.position - , remove : eltRemove.push unit - , sendTo : eltSendTo.push + , position: eltRegion.position + , remove: eltRemove.push unit + , sendTo: eltSendTo.push } - + eltPSR :: PSR eltPSR = - PSR { region, unsubs : [], lifecycle : remove } + PSR { region, unsubs: [], lifecycle: remove } handleManagedLifecycle :: EffectFn1 Unit Unit handleManagedLifecycle = @@ -515,10 +521,10 @@ useDynWith elements options cont = Nut $ mkEffectFn2 \psr di -> do handleSendTo = mkEffectFn1 \newPos -> do fromBegin <- liftST eltRegion.begin fromEnd <- liftST eltRegion.end - liftST $ runSTFn1 eltRegion.sendTo newPos + liftST $ runSTFn1 eltRegion.sendTo newPos target <- liftST eltRegion.begin - runEffectFn3 ( un DOMInterpret di ).beamRegion fromBegin fromEnd target + runEffectFn3 (un DOMInterpret di).beamRegion fromBegin fromEnd target pump eltUnsubs sendTo handleSendTo pump eltUnsubs remove handleManagedLifecycle @@ -531,9 +537,9 @@ useDynWith elements options cont = Nut $ mkEffectFn2 \psr di -> do lifecycle.push unit -- and only then unsub runEffectFn1 disposeUnsubs unsubs - + pump unsubs elements handleElements - pump unsubs ( un PSR psr ).lifecycle handleDynLifecycle + pump unsubs (un PSR psr).lifecycle handleDynLifecycle fixed :: Array Nut -> Nut fixed nuts = Nut $ mkEffectFn2 \psr di -> do @@ -543,9 +549,9 @@ fixed nuts = Nut $ mkEffectFn2 \psr di -> do over PSR _ { unsubs = [] } psr handleNuts :: EffectFn1 Nut Unit - handleNuts = mkEffectFn1 \( Nut nut ) -> + handleNuts = mkEffectFn1 \(Nut nut) -> runEffectFn2 nut cleared di - + Nut dispose = mempty -- run `nuts` without `unsubs` so they can't dispose them @@ -561,106 +567,108 @@ elementify -> Array Nut -> Nut elementify ns tag arrAtts nuts = Nut $ mkEffectFn2 \psr di -> do - elt <- runEffectFn2 ( un DOMInterpret di ).makeElement ( Namespace <$> ns ) ( Tag tag ) - regionEnd <- liftST ( un StaticRegion ( un PSR psr ).region ).end - runEffectFn2 ( un DOMInterpret di ).attachElement ( DekuChild elt ) regionEnd - liftST $ runSTFn1 ( un StaticRegion ( un PSR psr ).region ).element ( Element ( elt ) ) + elt <- runEffectFn2 (un DOMInterpret di).makeElement (Namespace <$> ns) + (Tag tag) + regionEnd <- liftST (un StaticRegion (un PSR psr).region).end + runEffectFn2 (un DOMInterpret di).attachElement (DekuChild elt) regionEnd + liftST $ runSTFn1 (un StaticRegion (un PSR psr).region).element + (Element (elt)) unsubs <- runEffectFn1 collectUnsubs psr let - handleAtts :: EffectFn1 ( Poll ( Attribute element ) ) Unit + handleAtts :: EffectFn1 (Poll (Attribute element)) Unit handleAtts = mkEffectFn1 \atts -> - pump unsubs atts $ mkEffectFn1 \( Attribute x ) -> + pump unsubs atts $ mkEffectFn1 \(Attribute x) -> runEffectFn2 x (fromDekuElement elt) di runEffectFn2 Event.fastForeachE arrAtts handleAtts eltRegion <- liftST $ runSTFn1 fromParent $ DekuParent elt let handleNuts :: EffectFn1 Nut Unit - handleNuts = mkEffectFn1 \( Nut nut ) -> - runEffectFn2 nut + handleNuts = mkEffectFn1 \(Nut nut) -> + runEffectFn2 nut ( PSR - { unsubs : [] - , lifecycle : ( un PSR psr ).lifecycle - , region : eltRegion - } + { unsubs: [] + , lifecycle: (un PSR psr).lifecycle + , region: eltRegion + } ) di runEffectFn2 Event.fastForeachE nuts handleNuts - let + let handleLifecycle :: EffectFn1 Unit Unit handleLifecycle = mkEffectFn1 \_ -> do - runEffectFn1 ( un DOMInterpret di ).removeElement elt + runEffectFn1 (un DOMInterpret di).removeElement elt runEffectFn1 disposeUnsubs unsubs - pump unsubs ( un PSR psr ).lifecycle handleLifecycle + pump unsubs (un PSR psr).lifecycle handleLifecycle text_ :: String -> Nut text_ txt = - text ( pure @Poll txt ) + text (pure @Poll txt) text :: Poll String -> Nut text texts = Nut $ mkEffectFn2 \psr di -> do unsubs <- runEffectFn1 collectUnsubs psr - + let - handleTextUpdate :: EffectFn2 ( Event.Event String ) DekuText Unit + handleTextUpdate :: EffectFn2 (Event.Event String) DekuText Unit handleTextUpdate = mkEffectFn2 \xs txt -> do sub <- runEffectFn2 Event.subscribeO xs $ mkEffectFn1 \x -> - runEffectFn2 ( un DOMInterpret di ).setText x txt + runEffectFn2 (un DOMInterpret di).setText x txt void $ liftST $ STArray.push sub unsubs - txt <- case texts of + txt <- case texts of OnlyPure xs -> do - runEffectFn1 ( un DOMInterpret di ).makeText ( Array.last xs ) - + runEffectFn1 (un DOMInterpret di).makeText (Array.last xs) + OnlyEvent e -> do - txt <- runEffectFn1 ( un DOMInterpret di ).makeText Nothing + txt <- runEffectFn1 (un DOMInterpret di).makeText Nothing runEffectFn2 handleTextUpdate e txt pure txt OnlyPoll p -> do - txt <- runEffectFn1 ( un DOMInterpret di ).makeText Nothing - bang <- liftST Event.create - runEffectFn2 handleTextUpdate ( UPoll.sample p bang.event ) txt + txt <- runEffectFn1 (un DOMInterpret di).makeText Nothing + bang <- liftST Event.create + runEffectFn2 handleTextUpdate (UPoll.sample p bang.event) txt bang.push identity pure txt PureAndEvent xs e -> do - txt <- runEffectFn1 ( un DOMInterpret di ).makeText ( Array.last xs ) + txt <- runEffectFn1 (un DOMInterpret di).makeText (Array.last xs) runEffectFn2 handleTextUpdate e txt pure txt PureAndPoll xs p -> do - txt <- runEffectFn1 ( un DOMInterpret di ).makeText ( Array.last xs ) - bang <- liftST Event.create - runEffectFn2 handleTextUpdate ( UPoll.sample p bang.event ) txt + txt <- runEffectFn1 (un DOMInterpret di).makeText (Array.last xs) + bang <- liftST Event.create + runEffectFn2 handleTextUpdate (UPoll.sample p bang.event) txt bang.push identity pure txt - - regionEnd <- liftST ( un StaticRegion ( un PSR psr ).region ).end - runEffectFn2 ( un DOMInterpret di ).attachText txt regionEnd - liftST $ runSTFn1 ( un StaticRegion ( un PSR psr ).region ).element ( Text txt ) + + regionEnd <- liftST (un StaticRegion (un PSR psr).region).end + runEffectFn2 (un DOMInterpret di).attachText txt regionEnd + liftST $ runSTFn1 (un StaticRegion (un PSR psr).region).element (Text txt) let handleLifecycle :: EffectFn1 Unit Unit handleLifecycle = mkEffectFn1 \_ -> do - runEffectFn1 ( un DOMInterpret di ).removeText txt + runEffectFn1 (un DOMInterpret di).removeText txt runEffectFn1 disposeUnsubs unsubs - pump unsubs ( un PSR psr ).lifecycle handleLifecycle + pump unsubs (un PSR psr).lifecycle handleLifecycle -- | Creates a `Nut` that can be attached to another part of the application. The lifetime of the `Nut` is no longer -- | than that of `Nut` that created it. -- maybe also attach the lifetime to its mountpoints and/or do reference counting portal :: Nut -> Hook Nut -portal ( Nut toBeam ) cont = Nut $ mkEffectFn2 \psr di -> do +portal (Nut toBeam) cont = Nut $ mkEffectFn2 \psr di -> do -- set up a StaticRegion for the portal contents and track its begin and end - buffer <- ( un DOMInterpret di ).bufferPortal - trackBegin <- liftST $ ST.new $ pure @( ST.ST Global ) $ ParentStart buffer + buffer <- (un DOMInterpret di).bufferPortal + trackBegin <- liftST $ ST.new $ pure @(ST.ST Global) $ ParentStart buffer trackEnd <- liftST $ ST.new $ Nothing @Bound -- signal for other locations of the portal that it's contents have moved @@ -668,63 +676,70 @@ portal ( Nut toBeam ) cont = Nut $ mkEffectFn2 \psr di -> do bumped <- liftST Event.createPure staticBuffer <- liftST $ runSTFn2 newStaticRegion - ( join $ ST.read trackBegin ) + (join $ ST.read trackBegin) ( mkSTFn1 \bound -> do - void $ ST.write bound trackEnd - bumped.push bound + void $ ST.write bound trackEnd + bumped.push bound ) - runEffectFn2 toBeam ( over PSR _ { region = staticBuffer } psr ) di - + runEffectFn2 toBeam (over PSR _ { region = staticBuffer } psr) di + let - Nut hooked = cont $ portaled ( beamed.push unit ) beamed.event bumped.event trackBegin trackEnd + Nut hooked = cont $ portaled (beamed.push unit) beamed.event bumped.event + trackBegin + trackEnd runEffectFn2 hooked psr di -portaled :: Effect Unit - -> Event.Event Unit - -> Event.Event ( Maybe Bound ) +portaled + :: Effect Unit + -> Event.Event Unit + -> Event.Event (Maybe Bound) -> ST.STRef Global Bound - -> ST.STRef Global ( Maybe Bound ) + -> ST.STRef Global (Maybe Bound) -> Nut -portaled beam beamed bumped trackBegin trackEnd = Nut $ mkEffectFn2 \psr di -> do - -- signal to other portaled `Nut`s that we are about to steal their content - beam - - -- set up region and its eventual cleanup - Region region <- liftST ( un StaticRegion ( un PSR psr ).region ).region - stolen <- liftST $ ST.new false - let - -- when someone else beams from the portal or the `Nut` gets removed we clean up the region - cleanRegion :: Effect Unit - cleanRegion = - whenM ( not <$> liftST ( ST.read stolen ) ) do - void $ liftST $ ST.write true stolen - liftST region.remove - - unsubBeamed <- runEffectFn2 Event.subscribeO beamed $ mkEffectFn1 \_ -> cleanRegion - unsubBumped <- runEffectFn2 Event.subscribeO bumped $ mkEffectFn1 $ liftST <<< runSTFn1 region.bump - - -- region starts empty, only bump when we actually have an end - liftST $ ST.read trackEnd >>= traverse_ ( runSTFn1 region.bump <<< Just ) - - -- actuall insert portal contents - begin <- liftST $ join $ ST.read trackBegin - end <- liftST $ sequence =<< ST.read trackEnd - target <- liftST region.begin - runEffectFn3 ( un DOMInterpret di ).beamRegion begin ( fromMaybe begin end ) target - - -- update the tracked begin so other portaled `Nut`s can steal the contents correctly - void $ liftST $ ST.write region.begin trackBegin - - -- lifecycle handling - unsubs <- runEffectFn1 collectUnsubs psr - void $ liftST $ STArray.push unsubBeamed unsubs - void $ liftST $ STArray.push unsubBumped unsubs - - let - handleLifecycle :: EffectFn1 Unit Unit - handleLifecycle = mkEffectFn1 \_ -> do - runEffectFn1 disposeUnsubs unsubs +portaled beam beamed bumped trackBegin trackEnd = Nut $ mkEffectFn2 \psr di -> + do + -- signal to other portaled `Nut`s that we are about to steal their content + beam + + -- set up region and its eventual cleanup + Region region <- liftST (un StaticRegion (un PSR psr).region).region + stolen <- liftST $ ST.new false + let + -- when someone else beams from the portal or the `Nut` gets removed we clean up the region + cleanRegion :: Effect Unit + cleanRegion = + whenM (not <$> liftST (ST.read stolen)) do + void $ liftST $ ST.write true stolen + liftST region.remove + + unsubBeamed <- runEffectFn2 Event.subscribeO beamed $ mkEffectFn1 \_ -> cleanRegion - - pump unsubs ( un PSR psr ).lifecycle handleLifecycle \ No newline at end of file + unsubBumped <- runEffectFn2 Event.subscribeO bumped $ mkEffectFn1 $ liftST + <<< runSTFn1 region.bump + + -- region starts empty, only bump when we actually have an end + liftST $ ST.read trackEnd >>= traverse_ (runSTFn1 region.bump <<< Just) + + -- actuall insert portal contents + begin <- liftST $ join $ ST.read trackBegin + end <- liftST $ sequence =<< ST.read trackEnd + target <- liftST region.begin + runEffectFn3 (un DOMInterpret di).beamRegion begin (fromMaybe begin end) + target + + -- update the tracked begin so other portaled `Nut`s can steal the contents correctly + void $ liftST $ ST.write region.begin trackBegin + + -- lifecycle handling + unsubs <- runEffectFn1 collectUnsubs psr + void $ liftST $ STArray.push unsubBeamed unsubs + void $ liftST $ STArray.push unsubBumped unsubs + + let + handleLifecycle :: EffectFn1 Unit Unit + handleLifecycle = mkEffectFn1 \_ -> do + runEffectFn1 disposeUnsubs unsubs + cleanRegion + + pump unsubs (un PSR psr).lifecycle handleLifecycle \ No newline at end of file diff --git a/deku-core/src/Deku/FullDOMInterpret.purs b/deku-core/src/Deku/FullDOMInterpret.purs index ce4ed7a3..b9848214 100644 --- a/deku-core/src/Deku/FullDOMInterpret.purs +++ b/deku-core/src/Deku/FullDOMInterpret.purs @@ -6,17 +6,17 @@ import Deku.Interpret as I fullDOMInterpret :: Core.DOMInterpret fullDOMInterpret = Core.DOMInterpret { makeElement: I.makeElementEffect - , attachElement : I.attachElementEffect + , attachElement: I.attachElementEffect , setProp: I.setPropEffect , setCb: I.setCbEffect , unsetAttribute: I.unsetAttributeEffect , removeElement: I.removeElementEffect -- , makeText: I.makeTextEffect - , attachText : I.attachTextEffect + , attachText: I.attachTextEffect , setText: I.setTextEffect , removeText: I.removeTextEffect -- - , beamRegion : I.beamRegionEffect - , bufferPortal : I.bufferPortal + , beamRegion: I.beamRegionEffect + , bufferPortal: I.bufferPortal } \ No newline at end of file diff --git a/deku-core/src/Deku/Internal/Entities.purs b/deku-core/src/Deku/Internal/Entities.purs index 0f070bba..07d07886 100644 --- a/deku-core/src/Deku/Internal/Entities.purs +++ b/deku-core/src/Deku/Internal/Entities.purs @@ -1,30 +1,30 @@ -module Deku.Internal.Entities where - -import Unsafe.Coerce (unsafeCoerce) - -data DekuElement - -toDekuElement :: forall @a . a -> DekuElement -toDekuElement = unsafeCoerce - -fromDekuElement :: forall @a . DekuElement -> a -fromDekuElement = unsafeCoerce - -data DekuText - -toDekuText :: forall @a . a -> DekuText -toDekuText = unsafeCoerce - -fromDekuText :: forall @a . DekuText -> a -fromDekuText = unsafeCoerce - -data DekuEvent - -toDekuEvent :: forall @a . a -> DekuEvent -toDekuEvent = unsafeCoerce - -fromDekuEvent :: forall @a . DekuEvent -> a -fromDekuEvent = unsafeCoerce - -newtype DekuChild = DekuChild DekuElement +module Deku.Internal.Entities where + +import Unsafe.Coerce (unsafeCoerce) + +data DekuElement + +toDekuElement :: forall @a. a -> DekuElement +toDekuElement = unsafeCoerce + +fromDekuElement :: forall @a. DekuElement -> a +fromDekuElement = unsafeCoerce + +data DekuText + +toDekuText :: forall @a. a -> DekuText +toDekuText = unsafeCoerce + +fromDekuText :: forall @a. DekuText -> a +fromDekuText = unsafeCoerce + +data DekuEvent + +toDekuEvent :: forall @a. a -> DekuEvent +toDekuEvent = unsafeCoerce + +fromDekuEvent :: forall @a. DekuEvent -> a +fromDekuEvent = unsafeCoerce + +newtype DekuChild = DekuChild DekuElement newtype DekuParent = DekuParent DekuElement \ No newline at end of file diff --git a/deku-core/src/Deku/Internal/Region.purs b/deku-core/src/Deku/Internal/Region.purs index 123f7784..093487da 100644 --- a/deku-core/src/Deku/Internal/Region.purs +++ b/deku-core/src/Deku/Internal/Region.purs @@ -1,450 +1,480 @@ --- | `Region`s are used to figure out the bounds of collections of managed elements. The difficulty lies mostly in empty --- | managed regions, they have nothing to get a hold of and need to be managed outside of the DOM. To communicate the --- | presence or absence of elements, `Region`s have to use `Bump Just` to signal to their parents that they contain an --- | element that can be used to locate a region or `Bump Nothing` to signal that it contains no elements to locate. --- | --- | It is then the responsibilty of the parent to use the information of all its children to provide correct `Bound` --- | information to i.e. `DOMInterpret` to use `attachElement` or `beamRegion`. A `Bump Just` causes all following `Region`s --- | to update their begin(and their end when empty) until a new non-empty region is found. A `Bump Nothing` causes the --- | inverse. First a non-empty `Region` has be found which will be used to update the beginning of all following empty --- | `Region`s until a new non-empty `Region` is found. -module Deku.Internal.Region - ( Anchor(..) - , Bound - , Region(..) - , StaticRegion(..) - , RegionSpan(..) - , Bump - , fromParent - , newStaticRegion - ) where - -import Prelude - -import Control.Alt ((<|>)) -import Control.Monad.ST.Global (Global) -import Control.Monad.ST.Internal as ST -import Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, STFn4, mkSTFn1, mkSTFn2, mkSTFn3, mkSTFn4, runSTFn1, runSTFn2, runSTFn3, runSTFn4) -import Control.Plus (empty) -import Data.Array as Array -import Data.Array.ST as STArray -import Data.Foldable (traverse_) -import Data.Maybe (Maybe(..), fromJust, fromMaybe) -import Data.Newtype (class Newtype) -import Deku.Internal.Entities (DekuElement, DekuParent, DekuText) -import FRP.Event (createPure) -import FRP.Poll (Poll, pollFromEvent, stRefToPoll) -import Partial.Unsafe (unsafePartial) - -data Anchor - = ParentStart DekuParent - | Element DekuElement - | Text DekuText - -type Bound = - ST.ST Global Anchor - -type Bump = - STFn1 ( Maybe Bound ) Global Unit - --- | Region that supports adding, moving and removing new child regions. -newtype Region = Region - { begin :: Bound - , end :: Bound - - , position :: Poll Int - , sendTo :: STFn1 Int Global Unit - , remove :: ST.ST Global Unit - - , bump :: Bump - } -derive instance Newtype Region _ - --- | Region that supports adding new regions and elements. -newtype StaticRegion = StaticRegion - { end :: Bound - , span :: ST.ST Global RegionSpan - , region :: ST.ST Global Region - , element :: STFn1 Anchor Global Unit - } -derive instance Newtype StaticRegion _ - -type SharedBound' = - { owner :: ST.STRef Global ( ST.ST Global Int ) - , extent :: ST.STRef Global ( ST.ST Global Int ) - , ref :: ST.STRef Global Bound - } - -type SharedBound = - ST.STRef Global SharedBound' - -type ManagedRegion = - { ix :: ST.ST Global Int - , pushIx :: STFn1 Int Global Unit - , position :: Poll Int - , begin :: SharedBound - , end :: SharedBound - } - -readSharedBound :: STFn1 SharedBound Global Anchor -readSharedBound = mkSTFn1 \shared -> do - { ref } <- ST.read shared - bound <- ST.read ref - bound - --- | Managed span of `Region`s. -newtype RegionSpan = - RegionSpan ( STFn1 ( Maybe Int ) Global Region ) -derive instance Newtype RegionSpan _ - -newSpan :: STFn2 Bound Bump Global RegionSpan -newSpan = mkSTFn2 \parent parentBump -> do - children <- STArray.new - -- bound owned by an element outside of this region - - parentRef <- ST.new 0 - parentBound <- do - owner <- ST.new $ ST.read parentRef - extent <- ST.new $ ST.read parentRef - ref <- ST.new parent - ST.new { owner, extent, ref } - let - parentRegion :: ManagedRegion - parentRegion = - { ix : ST.read parentRef - , pushIx : mkSTFn1 \_ -> mempty - , position : empty - , begin : parentBound - , end : parentBound - } - void $ STArray.push parentRegion children - pure $ RegionSpan $ mkSTFn1 \givenPos -> do - managed@{ position, ix } <- runSTFn2 insertManaged givenPos children - let - begin :: Bound - begin = - runSTFn1 readSharedBound managed.begin - - end :: Bound - end = - runSTFn1 readSharedBound managed.end - - bump :: Bump - bump = mkSTFn1 case _ of - Nothing -> do - runSTFn2 clearBound managed children - whenM ( runSTFn1 isClear children ) do - runSTFn1 parentBump Nothing - - b@( Just bound ) -> do - runSTFn3 bumpBound bound managed children - whenM ( runSTFn2 isLastBound managed children ) ( runSTFn1 parentBump b ) - - sendTo :: STFn1 Int Global Unit - sendTo = mkSTFn1 \pos -> do - lastBound <- ST.new $ Nothing @Bound - wasLast <- runSTFn2 isLastBound managed children - whenM ( not <$> runSTFn1 isEmpty managed ) do - { ref } <- ST.read managed.end - bound <- ST.read ref - void $ ST.write ( Just bound ) lastBound - -- clear the region so the previous region get's hooked up to the following - runSTFn2 clearBound managed children - - -- now safe to move, indices becoming invalid - lastIx <- ix - removed <- STArray.splice lastIx ( lastIx + 1 ) [] children - void $ STArray.splice pos pos removed children - - newBegin <- runSTFn2 shareBound managed.ix children - void $ ST.write newBegin managed.begin - void $ ST.write newBegin managed.end - - -- restoring indices - runSTFn3 fixManaged ( min lastIx pos ) updateIx children - - -- if we had any elements we signal a bump, this requires the indices to be valid so we do it last - ST.read lastBound >>= traverse_ \bound -> runSTFn3 bumpBound bound managed children - - -- update parent when necessary - nowLast <- runSTFn2 isLastBound managed children - when ( wasLast /= nowLast ) do - runSTFn2 rebumpLast parentBump children - - remove :: ST.ST Global Unit - remove = do - runSTFn1 bump Nothing - finalIx <- ix - void $ STArray.splice finalIx ( finalIx + 1 ) [] children - runSTFn3 fixManaged finalIx updateIx children - - pure $ Region { begin, end, position, sendTo, remove, bump } - --- | Determines the final `Bound` and runs the provided effect on it. --- | ASSUMES that the last element is not the parent. -rebumpLast :: STFn2 Bump ( STArray.STArray Global ManagedRegion ) Global Unit -rebumpLast = mkSTFn2 \bump children -> do - length <- STArray.length children - STArray.peek ( length - 1 ) children >>= traverse_ \lastRegion -> do - end <- ST.read lastRegion.end - bound <- ST.read end.ref - runSTFn1 bump $ Just bound - --- | Uses the bound information to infer if the whole span is empty. -isClear :: STFn1 ( STArray.STArray Global ManagedRegion ) Global Boolean -isClear = mkSTFn1 \children -> do - length <- STArray.length children - -- there is always atleast one element - last <- unsafePartial $ fromJust <$> STArray.peek ( length - 1 ) children - begin <- ST.read last.begin - owner <- join $ ST.read begin.owner - if owner > 0 then -- begin is not parent so we have atleat one non-empty element - pure false - else do - extent <- join $ ST.read begin.extent - pure $ ( length - 1 ) == extent - -isEmpty :: STFn1 ManagedRegion Global Boolean -isEmpty = mkSTFn1 \{ ix, end } -> do - { owner } <- ST.read end - -- if the `ManagedRegion` does not own its end it's considered empty - notEq <$> ( join $ ST.read owner ) <*> ix - --- | Returns whether the `ManagedRegion` controls the ending bound of the whole span. -isLastBound :: STFn2 ManagedRegion ( STArray.STArray Global ManagedRegion ) Global Boolean -isLastBound = mkSTFn2 \region children -> do - length <- STArray.length children - end <- ST.read region.end - owner <- join $ ST.read end.owner - pos <- region.ix - extent <- join $ ST.read end.extent - pure $ owner == pos && extent == length - 1 - --- | Creates a new `ShareBound'` value for an empty `ManagedRegion`. It looks up the preceding `ManagedRegion` and uses --- | its end `SharedBound` possibly extending it. -shareBound :: STFn2 ( ST.ST Global Int ) ( STArray.STArray Global ManagedRegion ) Global SharedBound' -shareBound = mkSTFn2 \posRef children -> do - pos <- posRef - -- prev should always be present, shareBound is called with an actual child element and the first element is the - -- always the parentRegion - prev <- unsafePartial $ fromJust <$> STArray.peek ( pos - 1 ) children - beginFromPrev <- ST.read prev.end - currentExtent <- join $ ST.read beginFromPrev.extent - - -- If the currentExtent is equal or greater to our pos then the region will be inserted before the end of the - -- `SharedBound` and we dont have to anything. - -- otherwise we are getting inserted at the end of the `SharedBound` so we set it up to track our position - when ( currentExtent < pos ) do - void $ ST.write posRef beginFromPrev.extent - - pure beginFromPrev - --- | Lifts a `ManagedRegion` out of the `RegionSpan`, restoring the `SharedBound`s of its siblings. -clearBound :: STFn2 ManagedRegion ( STArray.STArray Global ManagedRegion ) Global Unit -clearBound = mkSTFn2 \cleared children -> do - clearedBound <- ST.read cleared.end - prevBound <- ST.read cleared.begin - - extentToEff <- ST.read clearedBound.extent - extentToIx <- extentToEff - ownerEff <- ST.read prevBound.owner - ownerIx <- ownerEff - selfIx <- join $ ST.read prevBound.extent - - -- choose the smaller `SharedBound` to update - if selfIx - ownerIx > extentToIx - selfIx then do - -- the following owned `SharedBound` was smaller - void $ ST.write extentToEff prevBound.extent - runSTFn4 fixManagedTo selfIx ( extentToIx + 1 ) ( updateShared prevBound ) children - - else do - -- the preceding not owned `SharedBound` was smaller, update the clearedBound with the information of - -- prevBound and update the `ManagedRegion`s - ref <- ST.read prevBound.ref - void $ ST.write ref clearedBound.ref - void $ ST.write ownerEff clearedBound.owner - - STArray.peek ( ownerIx ) children >>= traverse_ \{ end } -> void $ ST.write clearedBound end - runSTFn4 fixManagedTo ( ownerIx + 1 ) ( selfIx + 1 ) ( updateShared clearedBound ) children - --- | Updates the end of a `ManagedRegion`. If it shares that bound with a preceding sibling it will set up a new --- | `SharedBound` that it owns and propagates it to all following members of the old `SharedBound`. --- | Or it hijacks the previous `SharedBound`. -bumpBound :: STFn3 Bound ManagedRegion ( STArray.STArray Global ManagedRegion ) Global Unit -bumpBound = mkSTFn3 \bound bumped children -> do - empty <- runSTFn1 isEmpty bumped - if not empty then do - ownedBound <- ST.read bumped.end - void $ ST.write bound ownedBound.ref - else do - prevExtent <- ST.read bumped.begin - ownerEff <- ST.read prevExtent.owner - ownerIx <- ownerEff - - extentToEff <- ST.read prevExtent.extent - extentToIx <- extentToEff - selfIx <- bumped.ix - - prev <- unsafePartial $ fromJust <$> STArray.peek ( selfIx - 1 ) children - -- find the smallest possible update - if selfIx - ownerIx > extentToIx - selfIx then do - -- the following `SharedBound` will be smaller - void $ ST.write prev.ix prevExtent.extent - newShared <- do - owner <- ST.new bumped.ix - extent <- ST.new extentToEff - ref <- ST.new bound - pure { owner, extent, ref } - - void $ ST.write newShared bumped.end - runSTFn4 fixManagedTo ( selfIx + 1 ) extentToIx ( updateShared newShared ) children - - else do - -- preceding `SharedBound` will be smaller - newShared <- do - owner <- ST.new ownerEff - extent <- ST.new prev.ix - ref <- ST.new =<< ST.read prevExtent.ref - pure { owner, extent, ref } - - -- hijack longer `SharedBound` and update it with our own info - void $ ST.write bumped.ix prevExtent.owner - void $ ST.write bound prevExtent.ref - - void $ ST.write newShared bumped.begin - STArray.peek ownerIx children >>= traverse_ \ownerRegion -> void $ ST.write newShared ownerRegion.end - runSTFn4 fixManagedTo ( ownerIx - 1 ) ( selfIx - 1 ) ( updateShared newShared ) children - -insertManaged :: STFn2 ( Maybe Int ) ( STArray.STArray Global ManagedRegion ) Global ManagedRegion -insertManaged = mkSTFn2 \givenPos children -> do - length <- STArray.length children - let - pos :: Int - pos = clamp 0 length $ fromMaybe length givenPos - - ixRef <- ST.new pos - posEvent <- createPure - - let - pushIx :: STFn1 Int Global Unit - pushIx = mkSTFn1 \i -> do - void $ ST.write i ixRef - posEvent.push i - - ix :: ST.ST Global Int - ix = - ST.read ixRef - - position :: Poll Int - position = stRefToPoll ixRef <|> pollFromEvent posEvent.event - - prevBegin <- runSTFn2 shareBound ix children - begin <- ST.new prevBegin - end <- ST.new prevBegin - - let - managed :: ManagedRegion - managed = - { ix, begin, end, pushIx, position } - - void $ STArray.splice pos pos [ managed ] children - - runSTFn3 fixManaged ( pos + 1 ) updateIx children - pure managed - -updateShared :: SharedBound' -> STFn2 Int ManagedRegion Global Unit -updateShared shared = mkSTFn2 \_ region -> do - void $ ST.write shared region.begin - void $ ST.write shared region.end - -updateIx :: STFn2 Int ManagedRegion Global Unit -updateIx = - mkSTFn2 \i { pushIx } -> runSTFn1 pushIx i - --- TODO: expensive operation -fixManaged :: STFn3 Int ( STFn2 Int ManagedRegion Global Unit ) ( STArray.STArray Global ManagedRegion ) Global Unit -fixManaged = mkSTFn3 \from fn children -> do - length <- STArray.length children - runSTFn4 fixManagedTo from length fn children - -fixManagedTo :: STFn4 Int Int ( STFn2 Int ManagedRegion Global Unit ) ( STArray.STArray Global ManagedRegion ) Global Unit -fixManagedTo = mkSTFn4 \from to fn children -> do - elems <- STArray.unsafeFreeze children - ST.for from to \ix -> do - runSTFn2 fn ix ( unsafePartial ( Array.unsafeIndex elems ix ) ) - -data StaticRegionState - = Anchored ( ST.ST Global Anchor ) - | Spanning RegionSpan - -isSpanning :: StaticRegionState -> Boolean -isSpanning = case _ of - Spanning _ -> true - _ -> false - -newStaticRegion :: STFn2 Bound Bump Global StaticRegion -newStaticRegion = mkSTFn2 \parent bump -> do - spanCounter <- ST.new (-1) -- making the first span 0 - -- when any static element is added it can not be removed by this static region so this anchor can be used to bump - -- when the last child span signals a clear - state <- ST.new $ Anchored parent - - end <- ST.new parent - let - findOrCreateSpan :: ST.ST Global RegionSpan - findOrCreateSpan = ST.read state >>= case _ of - Anchored begin -> do - spanIx <- ST.modify ( add 1 ) spanCounter - span <- runSTFn2 newSpan - ( begin ) - ( mkSTFn1 case _ of - Nothing -> - whenM ( eq spanIx <$> ST.read spanCounter ) do - void $ ST.write begin end - -- only signal clear when we are the first and only span - when ( spanIx == 0 ) $ runSTFn1 bump Nothing - - a@( Just anchor ) -> - whenM ( eq spanIx <$> ST.read spanCounter ) do - void $ ST.write anchor end - runSTFn1 bump a - ) - - pure span - - Spanning span -> - pure span - - pure $ StaticRegion - { end : join $ ST.read end - , span : do - -- find or create a span - RegionSpan span <- findOrCreateSpan - - -- allocate a new region - Region region <- runSTFn1 span Nothing - - -- create a single span in that region, this double allocation is necessary to isolate two spans in the same - -- static region. - StaticRegion static <- runSTFn2 newStaticRegion region.begin region.bump - static.span - - , region : do - RegionSpan span <- findOrCreateSpan - runSTFn1 span Nothing - - , element : mkSTFn1 \anchor' -> do - let anchor = pure anchor' - whenM ( isSpanning <$> ST.read state ) do - -- clear span state - void $ ST.write ( Anchored anchor ) state - -- signal that the last span is no longer allowed to bump or clear - void $ ST.modify ( add 1 ) spanCounter - - void $ ST.write anchor end - runSTFn1 bump $ Just anchor - } - -fromParent :: STFn1 DekuParent Global StaticRegion -fromParent = - mkSTFn1 \parent -> runSTFn2 newStaticRegion ( pure $ ParentStart parent ) ( mkSTFn1 \_ -> pure unit ) +-- | `Region`s are used to figure out the bounds of collections of managed elements. The difficulty lies mostly in empty +-- | managed regions, they have nothing to get a hold of and need to be managed outside of the DOM. To communicate the +-- | presence or absence of elements, `Region`s have to use `Bump Just` to signal to their parents that they contain an +-- | element that can be used to locate a region or `Bump Nothing` to signal that it contains no elements to locate. +-- | +-- | It is then the responsibilty of the parent to use the information of all its children to provide correct `Bound` +-- | information to i.e. `DOMInterpret` to use `attachElement` or `beamRegion`. A `Bump Just` causes all following `Region`s +-- | to update their begin(and their end when empty) until a new non-empty region is found. A `Bump Nothing` causes the +-- | inverse. First a non-empty `Region` has be found which will be used to update the beginning of all following empty +-- | `Region`s until a new non-empty `Region` is found. +module Deku.Internal.Region + ( Anchor(..) + , Bound + , Region(..) + , StaticRegion(..) + , RegionSpan(..) + , Bump + , fromParent + , newStaticRegion + ) where + +import Prelude + +import Control.Alt ((<|>)) +import Control.Monad.ST.Global (Global) +import Control.Monad.ST.Internal as ST +import Control.Monad.ST.Uncurried (STFn1, STFn2, STFn3, STFn4, mkSTFn1, mkSTFn2, mkSTFn3, mkSTFn4, runSTFn1, runSTFn2, runSTFn3, runSTFn4) +import Control.Plus (empty) +import Data.Array as Array +import Data.Array.ST as STArray +import Data.Foldable (traverse_) +import Data.Maybe (Maybe(..), fromJust, fromMaybe) +import Data.Newtype (class Newtype) +import Deku.Internal.Entities (DekuElement, DekuParent, DekuText) +import FRP.Event (createPure) +import FRP.Poll (Poll, pollFromEvent, stRefToPoll) +import Partial.Unsafe (unsafePartial) + +data Anchor + = ParentStart DekuParent + | Element DekuElement + | Text DekuText + +type Bound = + ST.ST Global Anchor + +type Bump = + STFn1 (Maybe Bound) Global Unit + +-- | Region that supports adding, moving and removing new child regions. +newtype Region = Region + { begin :: Bound + , end :: Bound + + , position :: Poll Int + , sendTo :: STFn1 Int Global Unit + , remove :: ST.ST Global Unit + + , bump :: Bump + } + +derive instance Newtype Region _ + +-- | Region that supports adding new regions and elements. +newtype StaticRegion = StaticRegion + { end :: Bound + , span :: ST.ST Global RegionSpan + , region :: ST.ST Global Region + , element :: STFn1 Anchor Global Unit + } + +derive instance Newtype StaticRegion _ + +type SharedBound' = + { owner :: ST.STRef Global (ST.ST Global Int) + , extent :: ST.STRef Global (ST.ST Global Int) + , ref :: ST.STRef Global Bound + } + +type SharedBound = + ST.STRef Global SharedBound' + +type ManagedRegion = + { ix :: ST.ST Global Int + , pushIx :: STFn1 Int Global Unit + , position :: Poll Int + , begin :: SharedBound + , end :: SharedBound + } + +readSharedBound :: STFn1 SharedBound Global Anchor +readSharedBound = mkSTFn1 \shared -> do + { ref } <- ST.read shared + bound <- ST.read ref + bound + +-- | Managed span of `Region`s. +newtype RegionSpan = + RegionSpan (STFn1 (Maybe Int) Global Region) + +derive instance Newtype RegionSpan _ + +newSpan :: STFn2 Bound Bump Global RegionSpan +newSpan = mkSTFn2 \parent parentBump -> do + children <- STArray.new + -- bound owned by an element outside of this region + + parentRef <- ST.new 0 + parentBound <- do + owner <- ST.new $ ST.read parentRef + extent <- ST.new $ ST.read parentRef + ref <- ST.new parent + ST.new { owner, extent, ref } + let + parentRegion :: ManagedRegion + parentRegion = + { ix: ST.read parentRef + , pushIx: mkSTFn1 \_ -> mempty + , position: empty + , begin: parentBound + , end: parentBound + } + void $ STArray.push parentRegion children + pure $ RegionSpan $ mkSTFn1 \givenPos -> do + managed@{ position, ix } <- runSTFn2 insertManaged givenPos children + let + begin :: Bound + begin = + runSTFn1 readSharedBound managed.begin + + end :: Bound + end = + runSTFn1 readSharedBound managed.end + + bump :: Bump + bump = mkSTFn1 case _ of + Nothing -> do + runSTFn2 clearBound managed children + whenM (runSTFn1 isClear children) do + runSTFn1 parentBump Nothing + + b@(Just bound) -> do + runSTFn3 bumpBound bound managed children + whenM (runSTFn2 isLastBound managed children) (runSTFn1 parentBump b) + + sendTo :: STFn1 Int Global Unit + sendTo = mkSTFn1 \pos -> do + lastBound <- ST.new $ Nothing @Bound + wasLast <- runSTFn2 isLastBound managed children + whenM (not <$> runSTFn1 isEmpty managed) do + { ref } <- ST.read managed.end + bound <- ST.read ref + void $ ST.write (Just bound) lastBound + -- clear the region so the previous region get's hooked up to the following + runSTFn2 clearBound managed children + + -- now safe to move, indices becoming invalid + lastIx <- ix + removed <- STArray.splice lastIx (lastIx + 1) [] children + void $ STArray.splice pos pos removed children + + newBegin <- runSTFn2 shareBound managed.ix children + void $ ST.write newBegin managed.begin + void $ ST.write newBegin managed.end + + -- restoring indices + runSTFn3 fixManaged (min lastIx pos) updateIx children + + -- if we had any elements we signal a bump, this requires the indices to be valid so we do it last + ST.read lastBound >>= traverse_ \bound -> runSTFn3 bumpBound bound + managed + children + + -- update parent when necessary + nowLast <- runSTFn2 isLastBound managed children + when (wasLast /= nowLast) do + runSTFn2 rebumpLast parentBump children + + remove :: ST.ST Global Unit + remove = do + runSTFn1 bump Nothing + finalIx <- ix + void $ STArray.splice finalIx (finalIx + 1) [] children + runSTFn3 fixManaged finalIx updateIx children + + pure $ Region { begin, end, position, sendTo, remove, bump } + +-- | Determines the final `Bound` and runs the provided effect on it. +-- | ASSUMES that the last element is not the parent. +rebumpLast :: STFn2 Bump (STArray.STArray Global ManagedRegion) Global Unit +rebumpLast = mkSTFn2 \bump children -> do + length <- STArray.length children + STArray.peek (length - 1) children >>= traverse_ \lastRegion -> do + end <- ST.read lastRegion.end + bound <- ST.read end.ref + runSTFn1 bump $ Just bound + +-- | Uses the bound information to infer if the whole span is empty. +isClear :: STFn1 (STArray.STArray Global ManagedRegion) Global Boolean +isClear = mkSTFn1 \children -> do + length <- STArray.length children + -- there is always atleast one element + last <- unsafePartial $ fromJust <$> STArray.peek (length - 1) children + begin <- ST.read last.begin + owner <- join $ ST.read begin.owner + if owner > 0 then -- begin is not parent so we have atleat one non-empty element + + pure false + else do + extent <- join $ ST.read begin.extent + pure $ (length - 1) == extent + +isEmpty :: STFn1 ManagedRegion Global Boolean +isEmpty = mkSTFn1 \{ ix, end } -> do + { owner } <- ST.read end + -- if the `ManagedRegion` does not own its end it's considered empty + notEq <$> (join $ ST.read owner) <*> ix + +-- | Returns whether the `ManagedRegion` controls the ending bound of the whole span. +isLastBound + :: STFn2 ManagedRegion (STArray.STArray Global ManagedRegion) Global Boolean +isLastBound = mkSTFn2 \region children -> do + length <- STArray.length children + end <- ST.read region.end + owner <- join $ ST.read end.owner + pos <- region.ix + extent <- join $ ST.read end.extent + pure $ owner == pos && extent == length - 1 + +-- | Creates a new `ShareBound'` value for an empty `ManagedRegion`. It looks up the preceding `ManagedRegion` and uses +-- | its end `SharedBound` possibly extending it. +shareBound + :: STFn2 (ST.ST Global Int) (STArray.STArray Global ManagedRegion) Global + SharedBound' +shareBound = mkSTFn2 \posRef children -> do + pos <- posRef + -- prev should always be present, shareBound is called with an actual child element and the first element is the + -- always the parentRegion + prev <- unsafePartial $ fromJust <$> STArray.peek (pos - 1) children + beginFromPrev <- ST.read prev.end + currentExtent <- join $ ST.read beginFromPrev.extent + + -- If the currentExtent is equal or greater to our pos then the region will be inserted before the end of the + -- `SharedBound` and we dont have to anything. + -- otherwise we are getting inserted at the end of the `SharedBound` so we set it up to track our position + when (currentExtent < pos) do + void $ ST.write posRef beginFromPrev.extent + + pure beginFromPrev + +-- | Lifts a `ManagedRegion` out of the `RegionSpan`, restoring the `SharedBound`s of its siblings. +clearBound + :: STFn2 ManagedRegion (STArray.STArray Global ManagedRegion) Global Unit +clearBound = mkSTFn2 \cleared children -> do + clearedBound <- ST.read cleared.end + prevBound <- ST.read cleared.begin + + extentToEff <- ST.read clearedBound.extent + extentToIx <- extentToEff + ownerEff <- ST.read prevBound.owner + ownerIx <- ownerEff + selfIx <- join $ ST.read prevBound.extent + + -- choose the smaller `SharedBound` to update + if selfIx - ownerIx > extentToIx - selfIx then do + -- the following owned `SharedBound` was smaller + void $ ST.write extentToEff prevBound.extent + runSTFn4 fixManagedTo selfIx (extentToIx + 1) (updateShared prevBound) + children + + else do + -- the preceding not owned `SharedBound` was smaller, update the clearedBound with the information of + -- prevBound and update the `ManagedRegion`s + ref <- ST.read prevBound.ref + void $ ST.write ref clearedBound.ref + void $ ST.write ownerEff clearedBound.owner + + STArray.peek (ownerIx) children >>= traverse_ \{ end } -> void $ ST.write + clearedBound + end + runSTFn4 fixManagedTo (ownerIx + 1) (selfIx + 1) (updateShared clearedBound) + children + +-- | Updates the end of a `ManagedRegion`. If it shares that bound with a preceding sibling it will set up a new +-- | `SharedBound` that it owns and propagates it to all following members of the old `SharedBound`. +-- | Or it hijacks the previous `SharedBound`. +bumpBound + :: STFn3 Bound ManagedRegion (STArray.STArray Global ManagedRegion) Global + Unit +bumpBound = mkSTFn3 \bound bumped children -> do + empty <- runSTFn1 isEmpty bumped + if not empty then do + ownedBound <- ST.read bumped.end + void $ ST.write bound ownedBound.ref + else do + prevExtent <- ST.read bumped.begin + ownerEff <- ST.read prevExtent.owner + ownerIx <- ownerEff + + extentToEff <- ST.read prevExtent.extent + extentToIx <- extentToEff + selfIx <- bumped.ix + + prev <- unsafePartial $ fromJust <$> STArray.peek (selfIx - 1) children + -- find the smallest possible update + if selfIx - ownerIx > extentToIx - selfIx then do + -- the following `SharedBound` will be smaller + void $ ST.write prev.ix prevExtent.extent + newShared <- do + owner <- ST.new bumped.ix + extent <- ST.new extentToEff + ref <- ST.new bound + pure { owner, extent, ref } + + void $ ST.write newShared bumped.end + runSTFn4 fixManagedTo (selfIx + 1) extentToIx (updateShared newShared) + children + + else do + -- preceding `SharedBound` will be smaller + newShared <- do + owner <- ST.new ownerEff + extent <- ST.new prev.ix + ref <- ST.new =<< ST.read prevExtent.ref + pure { owner, extent, ref } + + -- hijack longer `SharedBound` and update it with our own info + void $ ST.write bumped.ix prevExtent.owner + void $ ST.write bound prevExtent.ref + + void $ ST.write newShared bumped.begin + STArray.peek ownerIx children >>= traverse_ \ownerRegion -> void $ + ST.write newShared ownerRegion.end + runSTFn4 fixManagedTo (ownerIx - 1) (selfIx - 1) (updateShared newShared) + children + +insertManaged + :: STFn2 (Maybe Int) (STArray.STArray Global ManagedRegion) Global + ManagedRegion +insertManaged = mkSTFn2 \givenPos children -> do + length <- STArray.length children + let + pos :: Int + pos = clamp 0 length $ fromMaybe length givenPos + + ixRef <- ST.new pos + posEvent <- createPure + + let + pushIx :: STFn1 Int Global Unit + pushIx = mkSTFn1 \i -> do + void $ ST.write i ixRef + posEvent.push i + + ix :: ST.ST Global Int + ix = + ST.read ixRef + + position :: Poll Int + position = stRefToPoll ixRef <|> pollFromEvent posEvent.event + + prevBegin <- runSTFn2 shareBound ix children + begin <- ST.new prevBegin + end <- ST.new prevBegin + + let + managed :: ManagedRegion + managed = + { ix, begin, end, pushIx, position } + + void $ STArray.splice pos pos [ managed ] children + + runSTFn3 fixManaged (pos + 1) updateIx children + pure managed + +updateShared :: SharedBound' -> STFn2 Int ManagedRegion Global Unit +updateShared shared = mkSTFn2 \_ region -> do + void $ ST.write shared region.begin + void $ ST.write shared region.end + +updateIx :: STFn2 Int ManagedRegion Global Unit +updateIx = + mkSTFn2 \i { pushIx } -> runSTFn1 pushIx i + +-- TODO: expensive operation +fixManaged + :: STFn3 Int (STFn2 Int ManagedRegion Global Unit) + (STArray.STArray Global ManagedRegion) + Global + Unit +fixManaged = mkSTFn3 \from fn children -> do + length <- STArray.length children + runSTFn4 fixManagedTo from length fn children + +fixManagedTo + :: STFn4 Int Int (STFn2 Int ManagedRegion Global Unit) + (STArray.STArray Global ManagedRegion) + Global + Unit +fixManagedTo = mkSTFn4 \from to fn children -> do + elems <- STArray.unsafeFreeze children + ST.for from to \ix -> do + runSTFn2 fn ix (unsafePartial (Array.unsafeIndex elems ix)) + +data StaticRegionState + = Anchored (ST.ST Global Anchor) + | Spanning RegionSpan + +isSpanning :: StaticRegionState -> Boolean +isSpanning = case _ of + Spanning _ -> true + _ -> false + +newStaticRegion :: STFn2 Bound Bump Global StaticRegion +newStaticRegion = mkSTFn2 \parent bump -> do + spanCounter <- ST.new (-1) -- making the first span 0 + -- when any static element is added it can not be removed by this static region so this anchor can be used to bump + -- when the last child span signals a clear + state <- ST.new $ Anchored parent + + end <- ST.new parent + let + findOrCreateSpan :: ST.ST Global RegionSpan + findOrCreateSpan = ST.read state >>= case _ of + Anchored begin -> do + spanIx <- ST.modify (add 1) spanCounter + span <- runSTFn2 newSpan + (begin) + ( mkSTFn1 case _ of + Nothing -> + whenM (eq spanIx <$> ST.read spanCounter) do + void $ ST.write begin end + -- only signal clear when we are the first and only span + when (spanIx == 0) $ runSTFn1 bump Nothing + + a@(Just anchor) -> + whenM (eq spanIx <$> ST.read spanCounter) do + void $ ST.write anchor end + runSTFn1 bump a + ) + + pure span + + Spanning span -> + pure span + + pure $ StaticRegion + { end: join $ ST.read end + , span: do + -- find or create a span + RegionSpan span <- findOrCreateSpan + + -- allocate a new region + Region region <- runSTFn1 span Nothing + + -- create a single span in that region, this double allocation is necessary to isolate two spans in the same + -- static region. + StaticRegion static <- runSTFn2 newStaticRegion region.begin region.bump + static.span + + , region: do + RegionSpan span <- findOrCreateSpan + runSTFn1 span Nothing + + , element: mkSTFn1 \anchor' -> do + let anchor = pure anchor' + whenM (isSpanning <$> ST.read state) do + -- clear span state + void $ ST.write (Anchored anchor) state + -- signal that the last span is no longer allowed to bump or clear + void $ ST.modify (add 1) spanCounter + + void $ ST.write anchor end + runSTFn1 bump $ Just anchor + } + +fromParent :: STFn1 DekuParent Global StaticRegion +fromParent = + mkSTFn1 \parent -> runSTFn2 newStaticRegion (pure $ ParentStart parent) + (mkSTFn1 \_ -> pure unit) diff --git a/deku-core/src/Deku/Interpret.purs b/deku-core/src/Deku/Interpret.purs index 0044c302..910e0a5b 100644 --- a/deku-core/src/Deku/Interpret.purs +++ b/deku-core/src/Deku/Interpret.purs @@ -1,259 +1,260 @@ -module Deku.Interpret where - -import Prelude - -import Control.Monad.ST.Class (liftST) -import Data.Array.ST as STArray -import Data.Exists (Exists, mkExists, runExists) -import Data.Foldable (for_, traverse_) -import Data.List (List(..), (:)) -import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust) -import Data.Nullable (toMaybe) -import Deku.Core as Core -import Deku.Internal.Entities (DekuChild(..), DekuElement, DekuParent(..), fromDekuElement, fromDekuText, toDekuElement, toDekuText) -import Deku.Internal.Region (Anchor(..)) -import Deku.UnsafeDOM (addEventListener, after, createDocumentFragment, createElement, createElementNS, createText, eventListener, popCb, prepend, pushCb, removeEventListener, setTextContent) -import Effect (Effect, whileE) -import Effect.Ref as Ref -import Effect.Uncurried (EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4) -import Partial.Unsafe (unsafePartial) -import Safe.Coerce (coerce) -import Unsafe.Coerce (unsafeCoerce) -import Unsafe.Reference (unsafeRefEq) -import Web.DOM (ChildNode, Element, Node) -import Web.DOM.ChildNode (remove) -import Web.DOM.Element (removeAttribute, setAttribute) -import Web.DOM.Node (firstChild, nextSibling) -import Web.DOM.Text as Text -import Web.Event.Event (EventType(..)) -import Web.Event.Event as Web -import Web.Event.Internal.Types (EventTarget) -import Web.HTML.HTMLButtonElement as HTMLButtonElement -import Web.HTML.HTMLFieldSetElement as HTMLFieldSetElement -import Web.HTML.HTMLInputElement as HTMLInputElement -import Web.HTML.HTMLKeygenElement as HTMLKeygenElement -import Web.HTML.HTMLLinkElement as HTMLLinkElement -import Web.HTML.HTMLOptGroupElement as HTMLOptGroupElement -import Web.HTML.HTMLOptionElement as HTMLOptionElement -import Web.HTML.HTMLSelectElement as HTMLSelectElement -import Web.HTML.HTMLTextAreaElement as HTMLTextAreaElement - -makeElementEffect :: Core.MakeElement -makeElementEffect = mkEffectFn2 \ns tag -> do - elt <- case coerce ns :: Maybe String of - Nothing -> runEffectFn1 createElement (coerce tag) - Just ns' -> runEffectFn2 createElementNS ( coerce ns' ) (coerce tag) - pure $ toDekuElement elt - -attachElementEffect :: Core.AttachElement -attachElementEffect = - mkEffectFn2 \( DekuChild el ) -> runEffectFn2 attachNodeEffect [ fromDekuElement @Node el ] - -setPropEffect :: Core.SetProp -setPropEffect = mkEffectFn3 \(Core.Key k) (Core.Value v) elt' -> do - let elt = fromDekuElement elt' - let - o - | k == "value" - , Just ie <- HTMLInputElement.fromElement elt = HTMLInputElement.setValue - v - ie - | k == "value" - , Just tx <- HTMLTextAreaElement.fromElement elt = - HTMLTextAreaElement.setValue v tx - | k == "checked" - , Just ie <- HTMLInputElement.fromElement elt = - HTMLInputElement.setChecked (v == "true") ie - | k == "disabled" - , Just fe <- - getDisableable elt disableables = runExists - (\(FeO { f, e }) -> f (v == "true") e) - fe - | otherwise = setAttribute k v elt - o - -setCbEffect :: Core.SetCb -setCbEffect = mkEffectFn3 \(Core.Key k) (Core.Cb v) elt' -> do - if k == "@self@" then do - void $ v ((unsafeCoerce :: DekuElement -> Web.Event) elt') - else do - let asElt = fromDekuElement @Element elt' - l <- runEffectFn2 popCb k asElt - let eventType = EventType k - let eventTarget = fromDekuElement @EventTarget elt' - for_ (toMaybe l) \toRemove -> runEffectFn4 removeEventListener eventType - toRemove - false - eventTarget - nl <- runEffectFn1 eventListener $ mkEffectFn1 v - runEffectFn4 addEventListener eventType nl false eventTarget - runEffectFn3 pushCb k nl asElt - -unsetAttributeEffect :: Core.UnsetAttribute -unsetAttributeEffect = mkEffectFn2 \(Core.Key k) elt' -> do - let asElt = fromDekuElement @Element elt' - l <- runEffectFn2 popCb k asElt - let asEventTarget = fromDekuElement @EventTarget elt' - let eventType = EventType k - for_ (toMaybe l) \toRemove -> do - runEffectFn4 removeEventListener eventType toRemove false asEventTarget - removeAttribute k asElt - -removeElementEffect :: Core.RemoveElement -removeElementEffect = mkEffectFn1 \e -> do - remove ( fromDekuElement @ChildNode e) - -newtype FeI e = FeI - { f :: Boolean -> e -> Effect Unit, e :: Element -> Maybe e } - -newtype FeO e = FeO { f :: Boolean -> e -> Effect Unit, e :: e } - -disableables ∷ List (Exists FeI) -disableables = - mkExists - ( FeI - { e: HTMLButtonElement.fromElement - , f: HTMLButtonElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLInputElement.fromElement - , f: HTMLInputElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLFieldSetElement.fromElement - , f: HTMLFieldSetElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLKeygenElement.fromElement - , f: HTMLKeygenElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLLinkElement.fromElement - , f: HTMLLinkElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLOptGroupElement.fromElement - , f: HTMLOptGroupElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLOptionElement.fromElement - , f: HTMLOptionElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLSelectElement.fromElement - , f: HTMLSelectElement.setDisabled - } - ) - : mkExists - ( FeI - { e: HTMLTextAreaElement.fromElement - , f: HTMLTextAreaElement.setDisabled - } - ) - : Nil - -getDisableable :: Element -> List (Exists FeI) -> Maybe (Exists FeO) -getDisableable elt = go - - where - - go Nil = Nothing - go (x : _) - | Just o <- - runExists - (\(FeI { f, e }) -> e elt <#> \e' -> mkExists (FeO { f, e: e' })) - x = Just o - go (_ : y) = go y - -makeTextEffect :: Core.MakeText -makeTextEffect = mkEffectFn1 \mstr -> do - txt <- runEffectFn1 createText (fromMaybe "" mstr) - pure $ toDekuText txt - -attachTextEffect :: Core.AttachText -attachTextEffect = - mkEffectFn2 \txt -> runEffectFn2 attachNodeEffect [ fromDekuText @Node txt ] - -setTextEffect :: Core.SetText -setTextEffect = mkEffectFn2 \str txt' -> do - let txt = fromDekuText @Node txt' - runEffectFn2 setTextContent str txt - -removeTextEffect :: Core.RemoveText -removeTextEffect = mkEffectFn1 \t -> do - remove (Text.toChildNode (fromDekuText t)) - -bufferPortal :: Core.BufferPortal -bufferPortal = - DekuParent <<< toDekuElement <$> createDocumentFragment - -beamRegionEffect :: Core.BeamRegion -beamRegionEffect = mkEffectFn3 case _, _, _ of - _, ParentStart _, _ -> - pure unit - - ParentStart ( DekuParent parent ), end, target -> do - firstChild ( fromDekuElement @Node parent ) >>= traverse_ \first -> - runEffectFn3 beamNodes first ( toNode end ) target - - fromBegin, fromEnd, target -> do - let - beginNode = toNode fromBegin - endNode = toNode fromEnd - - -- if beginning equals the end `nextSibling` would overshoot, so just check now and abort - if unsafeRefEq beginNode endNode then - pure unit - else - nextSibling beginNode >>= traverse_ \first -> - runEffectFn3 beamNodes first endNode target - - where - - beamNodes :: EffectFn3 Node Node Anchor Unit - beamNodes = mkEffectFn3 \first end target -> do - - acc <- liftST $ STArray.new - next <- Ref.new $ Just first - - whileE ( isJust <$> Ref.read next ) do - current <- unsafePartial $ fromJust <$> Ref.read next - void $ liftST $ STArray.push current acc - - if unsafeRefEq current end then - void $ Ref.write Nothing next - else - void $ Ref.write <$> nextSibling current <@> next - - nodes <- liftST $ STArray.unsafeFreeze acc - runEffectFn2 attachNodeEffect nodes target - - toNode :: Anchor -> Node - toNode a = unsafePartial case a of - Element el -> fromDekuElement @Node el - Text txt -> fromDekuText @Node txt - -attachNodeEffect :: EffectFn2 ( Array Node ) Anchor Unit -attachNodeEffect = mkEffectFn2 \nodes -> case _ of - ParentStart ( DekuParent parent ) -> do - runEffectFn2 prepend nodes ( fromDekuElement @Node parent ) - - Element el -> do - runEffectFn2 after nodes ( fromDekuElement @Node el ) - - Text txt -> do - runEffectFn2 after nodes ( fromDekuText @Node txt ) +module Deku.Interpret where + +import Prelude + +import Control.Monad.ST.Class (liftST) +import Data.Array.ST as STArray +import Data.Exists (Exists, mkExists, runExists) +import Data.Foldable (for_, traverse_) +import Data.List (List(..), (:)) +import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust) +import Data.Nullable (toMaybe) +import Deku.Core as Core +import Deku.Internal.Entities (DekuChild(..), DekuElement, DekuParent(..), fromDekuElement, fromDekuText, toDekuElement, toDekuText) +import Deku.Internal.Region (Anchor(..)) +import Deku.UnsafeDOM (addEventListener, after, createDocumentFragment, createElement, createElementNS, createText, eventListener, popCb, prepend, pushCb, removeEventListener, setTextContent) +import Effect (Effect, whileE) +import Effect.Ref as Ref +import Effect.Uncurried (EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, mkEffectFn3, runEffectFn1, runEffectFn2, runEffectFn3, runEffectFn4) +import Partial.Unsafe (unsafePartial) +import Safe.Coerce (coerce) +import Unsafe.Coerce (unsafeCoerce) +import Unsafe.Reference (unsafeRefEq) +import Web.DOM (ChildNode, Element, Node) +import Web.DOM.ChildNode (remove) +import Web.DOM.Element (removeAttribute, setAttribute) +import Web.DOM.Node (firstChild, nextSibling) +import Web.DOM.Text as Text +import Web.Event.Event (EventType(..)) +import Web.Event.Event as Web +import Web.Event.Internal.Types (EventTarget) +import Web.HTML.HTMLButtonElement as HTMLButtonElement +import Web.HTML.HTMLFieldSetElement as HTMLFieldSetElement +import Web.HTML.HTMLInputElement as HTMLInputElement +import Web.HTML.HTMLKeygenElement as HTMLKeygenElement +import Web.HTML.HTMLLinkElement as HTMLLinkElement +import Web.HTML.HTMLOptGroupElement as HTMLOptGroupElement +import Web.HTML.HTMLOptionElement as HTMLOptionElement +import Web.HTML.HTMLSelectElement as HTMLSelectElement +import Web.HTML.HTMLTextAreaElement as HTMLTextAreaElement + +makeElementEffect :: Core.MakeElement +makeElementEffect = mkEffectFn2 \ns tag -> do + elt <- case coerce ns :: Maybe String of + Nothing -> runEffectFn1 createElement (coerce tag) + Just ns' -> runEffectFn2 createElementNS (coerce ns') (coerce tag) + pure $ toDekuElement elt + +attachElementEffect :: Core.AttachElement +attachElementEffect = + mkEffectFn2 \(DekuChild el) -> runEffectFn2 attachNodeEffect + [ fromDekuElement @Node el ] + +setPropEffect :: Core.SetProp +setPropEffect = mkEffectFn3 \(Core.Key k) (Core.Value v) elt' -> do + let elt = fromDekuElement elt' + let + o + | k == "value" + , Just ie <- HTMLInputElement.fromElement elt = HTMLInputElement.setValue + v + ie + | k == "value" + , Just tx <- HTMLTextAreaElement.fromElement elt = + HTMLTextAreaElement.setValue v tx + | k == "checked" + , Just ie <- HTMLInputElement.fromElement elt = + HTMLInputElement.setChecked (v == "true") ie + | k == "disabled" + , Just fe <- + getDisableable elt disableables = runExists + (\(FeO { f, e }) -> f (v == "true") e) + fe + | otherwise = setAttribute k v elt + o + +setCbEffect :: Core.SetCb +setCbEffect = mkEffectFn3 \(Core.Key k) (Core.Cb v) elt' -> do + if k == "@self@" then do + void $ v ((unsafeCoerce :: DekuElement -> Web.Event) elt') + else do + let asElt = fromDekuElement @Element elt' + l <- runEffectFn2 popCb k asElt + let eventType = EventType k + let eventTarget = fromDekuElement @EventTarget elt' + for_ (toMaybe l) \toRemove -> runEffectFn4 removeEventListener eventType + toRemove + false + eventTarget + nl <- runEffectFn1 eventListener $ mkEffectFn1 v + runEffectFn4 addEventListener eventType nl false eventTarget + runEffectFn3 pushCb k nl asElt + +unsetAttributeEffect :: Core.UnsetAttribute +unsetAttributeEffect = mkEffectFn2 \(Core.Key k) elt' -> do + let asElt = fromDekuElement @Element elt' + l <- runEffectFn2 popCb k asElt + let asEventTarget = fromDekuElement @EventTarget elt' + let eventType = EventType k + for_ (toMaybe l) \toRemove -> do + runEffectFn4 removeEventListener eventType toRemove false asEventTarget + removeAttribute k asElt + +removeElementEffect :: Core.RemoveElement +removeElementEffect = mkEffectFn1 \e -> do + remove (fromDekuElement @ChildNode e) + +newtype FeI e = FeI + { f :: Boolean -> e -> Effect Unit, e :: Element -> Maybe e } + +newtype FeO e = FeO { f :: Boolean -> e -> Effect Unit, e :: e } + +disableables ∷ List (Exists FeI) +disableables = + mkExists + ( FeI + { e: HTMLButtonElement.fromElement + , f: HTMLButtonElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLInputElement.fromElement + , f: HTMLInputElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLFieldSetElement.fromElement + , f: HTMLFieldSetElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLKeygenElement.fromElement + , f: HTMLKeygenElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLLinkElement.fromElement + , f: HTMLLinkElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLOptGroupElement.fromElement + , f: HTMLOptGroupElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLOptionElement.fromElement + , f: HTMLOptionElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLSelectElement.fromElement + , f: HTMLSelectElement.setDisabled + } + ) + : mkExists + ( FeI + { e: HTMLTextAreaElement.fromElement + , f: HTMLTextAreaElement.setDisabled + } + ) + : Nil + +getDisableable :: Element -> List (Exists FeI) -> Maybe (Exists FeO) +getDisableable elt = go + + where + + go Nil = Nothing + go (x : _) + | Just o <- + runExists + (\(FeI { f, e }) -> e elt <#> \e' -> mkExists (FeO { f, e: e' })) + x = Just o + go (_ : y) = go y + +makeTextEffect :: Core.MakeText +makeTextEffect = mkEffectFn1 \mstr -> do + txt <- runEffectFn1 createText (fromMaybe "" mstr) + pure $ toDekuText txt + +attachTextEffect :: Core.AttachText +attachTextEffect = + mkEffectFn2 \txt -> runEffectFn2 attachNodeEffect [ fromDekuText @Node txt ] + +setTextEffect :: Core.SetText +setTextEffect = mkEffectFn2 \str txt' -> do + let txt = fromDekuText @Node txt' + runEffectFn2 setTextContent str txt + +removeTextEffect :: Core.RemoveText +removeTextEffect = mkEffectFn1 \t -> do + remove (Text.toChildNode (fromDekuText t)) + +bufferPortal :: Core.BufferPortal +bufferPortal = + DekuParent <<< toDekuElement <$> createDocumentFragment + +beamRegionEffect :: Core.BeamRegion +beamRegionEffect = mkEffectFn3 case _, _, _ of + _, ParentStart _, _ -> + pure unit + + ParentStart (DekuParent parent), end, target -> do + firstChild (fromDekuElement @Node parent) >>= traverse_ \first -> + runEffectFn3 beamNodes first (toNode end) target + + fromBegin, fromEnd, target -> do + let + beginNode = toNode fromBegin + endNode = toNode fromEnd + + -- if beginning equals the end `nextSibling` would overshoot, so just check now and abort + if unsafeRefEq beginNode endNode then + pure unit + else + nextSibling beginNode >>= traverse_ \first -> + runEffectFn3 beamNodes first endNode target + + where + + beamNodes :: EffectFn3 Node Node Anchor Unit + beamNodes = mkEffectFn3 \first end target -> do + + acc <- liftST $ STArray.new + next <- Ref.new $ Just first + + whileE (isJust <$> Ref.read next) do + current <- unsafePartial $ fromJust <$> Ref.read next + void $ liftST $ STArray.push current acc + + if unsafeRefEq current end then + void $ Ref.write Nothing next + else + void $ Ref.write <$> nextSibling current <@> next + + nodes <- liftST $ STArray.unsafeFreeze acc + runEffectFn2 attachNodeEffect nodes target + + toNode :: Anchor -> Node + toNode a = unsafePartial case a of + Element el -> fromDekuElement @Node el + Text txt -> fromDekuText @Node txt + +attachNodeEffect :: EffectFn2 (Array Node) Anchor Unit +attachNodeEffect = mkEffectFn2 \nodes -> case _ of + ParentStart (DekuParent parent) -> do + runEffectFn2 prepend nodes (fromDekuElement @Node parent) + + Element el -> do + runEffectFn2 after nodes (fromDekuElement @Node el) + + Text txt -> do + runEffectFn2 after nodes (fromDekuText @Node txt) diff --git a/deku-core/src/Deku/Pursx.purs b/deku-core/src/Deku/Pursx.purs index a990e277..4e31dd00 100644 --- a/deku-core/src/Deku/Pursx.purs +++ b/deku-core/src/Deku/Pursx.purs @@ -191,6 +191,7 @@ else instance pursxableToMapRL _ r = Map.insert (reflectSymbol (Proxy :: _ k)) (Left (xa (to ((Record.get (Proxy :: _ k) r) :: z)))) (pursxableToMapRL (Proxy :: _ rest) r) + lenientPursx' :: forall r. PursxableToMap r => String -> String -> { | r } -> Nut lenientPursx' verb html r = purs $ PursxInfo htmlified mapified diff --git a/deku-core/src/Deku/PursxParser.purs b/deku-core/src/Deku/PursxParser.purs index 4189d803..0981980f 100644 --- a/deku-core/src/Deku/PursxParser.purs +++ b/deku-core/src/Deku/PursxParser.purs @@ -31,7 +31,17 @@ else instance , Sym.Cons x y tail , DoVerbForAttr verb tag acc2 x y onezero pursi pathi purso patho newTail ) => - DoVerbForAttr verb tag acc anything tail onezero pursi pathi purso patho newTail + DoVerbForAttr verb + tag + acc + anything + tail + onezero + pursi + pathi + purso + patho + newTail -- class @@ -64,7 +74,12 @@ else instance class IsWhiteSpace (space :: Symbol) instance IsWhiteSpace "" -else instance (Sym.Cons x y s, IsSingleWhiteSpace x, IsWhiteSpace y) => IsWhiteSpace s +else instance + ( Sym.Cons x y s + , IsSingleWhiteSpace x + , IsWhiteSpace y + ) => + IsWhiteSpace s class IsSingleWhiteSpace (s :: Symbol) @@ -81,9 +96,24 @@ class (path :: Row (RL.RowList Symbol)) | verb head tail -> purs path -instance (Sym.Cons x y tail, PXStart verb x y purs path) => PXStart verb " " tail purs path -instance (Sym.Cons x y tail, PXStart verb x y purs path) => PXStart verb "\t" tail purs path -instance (Sym.Cons x y tail, PXStart verb x y purs path) => PXStart verb "\n" tail purs path +instance + ( Sym.Cons x y tail + , PXStart verb x y purs path + ) => + PXStart verb " " tail purs path + +instance + ( Sym.Cons x y tail + , PXStart verb x y purs path + ) => + PXStart verb "\t" tail purs path + +instance + ( Sym.Cons x y tail + , PXStart verb x y purs path + ) => + PXStart verb "\n" tail purs path + instance ( Sym.Cons x y tail , PXTagPreName verb x y RL.Nil () () purso patho trailing @@ -529,7 +559,11 @@ instance -- class - PreEndTagFromTrailing (head :: Symbol) (tail :: Symbol) (tag :: Symbol) (newTrailing :: Symbol) + PreEndTagFromTrailing + (head :: Symbol) + (tail :: Symbol) + (tag :: Symbol) + (newTrailing :: Symbol) | head tail -> tag newTrailing instance @@ -550,33 +584,113 @@ instance ) => PreEndTagFromTrailing "\n" tail tag trailing -instance EndTagFromTrailing "a" tail "" tag trailing => PreEndTagFromTrailing "a" tail tag trailing -instance EndTagFromTrailing "b" tail "" tag trailing => PreEndTagFromTrailing "b" tail tag trailing -instance EndTagFromTrailing "c" tail "" tag trailing => PreEndTagFromTrailing "c" tail tag trailing -instance EndTagFromTrailing "d" tail "" tag trailing => PreEndTagFromTrailing "d" tail tag trailing -instance EndTagFromTrailing "e" tail "" tag trailing => PreEndTagFromTrailing "e" tail tag trailing -instance EndTagFromTrailing "f" tail "" tag trailing => PreEndTagFromTrailing "f" tail tag trailing -instance EndTagFromTrailing "g" tail "" tag trailing => PreEndTagFromTrailing "g" tail tag trailing -instance EndTagFromTrailing "h" tail "" tag trailing => PreEndTagFromTrailing "h" tail tag trailing -instance EndTagFromTrailing "i" tail "" tag trailing => PreEndTagFromTrailing "i" tail tag trailing -instance EndTagFromTrailing "j" tail "" tag trailing => PreEndTagFromTrailing "j" tail tag trailing -instance EndTagFromTrailing "k" tail "" tag trailing => PreEndTagFromTrailing "k" tail tag trailing -instance EndTagFromTrailing "l" tail "" tag trailing => PreEndTagFromTrailing "l" tail tag trailing -instance EndTagFromTrailing "m" tail "" tag trailing => PreEndTagFromTrailing "m" tail tag trailing -instance EndTagFromTrailing "n" tail "" tag trailing => PreEndTagFromTrailing "n" tail tag trailing -instance EndTagFromTrailing "o" tail "" tag trailing => PreEndTagFromTrailing "o" tail tag trailing -instance EndTagFromTrailing "p" tail "" tag trailing => PreEndTagFromTrailing "p" tail tag trailing -instance EndTagFromTrailing "q" tail "" tag trailing => PreEndTagFromTrailing "q" tail tag trailing -instance EndTagFromTrailing "r" tail "" tag trailing => PreEndTagFromTrailing "r" tail tag trailing -instance EndTagFromTrailing "s" tail "" tag trailing => PreEndTagFromTrailing "s" tail tag trailing -instance EndTagFromTrailing "t" tail "" tag trailing => PreEndTagFromTrailing "t" tail tag trailing -instance EndTagFromTrailing "u" tail "" tag trailing => PreEndTagFromTrailing "u" tail tag trailing -instance EndTagFromTrailing "v" tail "" tag trailing => PreEndTagFromTrailing "v" tail tag trailing -instance EndTagFromTrailing "w" tail "" tag trailing => PreEndTagFromTrailing "w" tail tag trailing -instance EndTagFromTrailing "x" tail "" tag trailing => PreEndTagFromTrailing "x" tail tag trailing -instance EndTagFromTrailing "y" tail "" tag trailing => PreEndTagFromTrailing "y" tail tag trailing -instance EndTagFromTrailing "z" tail "" tag trailing => PreEndTagFromTrailing "z" tail tag trailing -instance EndTagFromTrailing "-" tail "" tag trailing => PreEndTagFromTrailing "-" tail tag trailing +instance + EndTagFromTrailing "a" tail "" tag trailing => + PreEndTagFromTrailing "a" tail tag trailing + +instance + EndTagFromTrailing "b" tail "" tag trailing => + PreEndTagFromTrailing "b" tail tag trailing + +instance + EndTagFromTrailing "c" tail "" tag trailing => + PreEndTagFromTrailing "c" tail tag trailing + +instance + EndTagFromTrailing "d" tail "" tag trailing => + PreEndTagFromTrailing "d" tail tag trailing + +instance + EndTagFromTrailing "e" tail "" tag trailing => + PreEndTagFromTrailing "e" tail tag trailing + +instance + EndTagFromTrailing "f" tail "" tag trailing => + PreEndTagFromTrailing "f" tail tag trailing + +instance + EndTagFromTrailing "g" tail "" tag trailing => + PreEndTagFromTrailing "g" tail tag trailing + +instance + EndTagFromTrailing "h" tail "" tag trailing => + PreEndTagFromTrailing "h" tail tag trailing + +instance + EndTagFromTrailing "i" tail "" tag trailing => + PreEndTagFromTrailing "i" tail tag trailing + +instance + EndTagFromTrailing "j" tail "" tag trailing => + PreEndTagFromTrailing "j" tail tag trailing + +instance + EndTagFromTrailing "k" tail "" tag trailing => + PreEndTagFromTrailing "k" tail tag trailing + +instance + EndTagFromTrailing "l" tail "" tag trailing => + PreEndTagFromTrailing "l" tail tag trailing + +instance + EndTagFromTrailing "m" tail "" tag trailing => + PreEndTagFromTrailing "m" tail tag trailing + +instance + EndTagFromTrailing "n" tail "" tag trailing => + PreEndTagFromTrailing "n" tail tag trailing + +instance + EndTagFromTrailing "o" tail "" tag trailing => + PreEndTagFromTrailing "o" tail tag trailing + +instance + EndTagFromTrailing "p" tail "" tag trailing => + PreEndTagFromTrailing "p" tail tag trailing + +instance + EndTagFromTrailing "q" tail "" tag trailing => + PreEndTagFromTrailing "q" tail tag trailing + +instance + EndTagFromTrailing "r" tail "" tag trailing => + PreEndTagFromTrailing "r" tail tag trailing + +instance + EndTagFromTrailing "s" tail "" tag trailing => + PreEndTagFromTrailing "s" tail tag trailing + +instance + EndTagFromTrailing "t" tail "" tag trailing => + PreEndTagFromTrailing "t" tail tag trailing + +instance + EndTagFromTrailing "u" tail "" tag trailing => + PreEndTagFromTrailing "u" tail tag trailing + +instance + EndTagFromTrailing "v" tail "" tag trailing => + PreEndTagFromTrailing "v" tail tag trailing + +instance + EndTagFromTrailing "w" tail "" tag trailing => + PreEndTagFromTrailing "w" tail tag trailing + +instance + EndTagFromTrailing "x" tail "" tag trailing => + PreEndTagFromTrailing "x" tail tag trailing + +instance + EndTagFromTrailing "y" tail "" tag trailing => + PreEndTagFromTrailing "y" tail tag trailing + +instance + EndTagFromTrailing "z" tail "" tag trailing => + PreEndTagFromTrailing "z" tail tag trailing + +instance + EndTagFromTrailing "-" tail "" tag trailing => + PreEndTagFromTrailing "-" tail tag trailing -- class @@ -868,192 +982,828 @@ class instance Sym.Cons ">" trailing tail => - PXTagPreAttrName verb hasAttributed tag "/" tail onezero purs path purs path trailing + PXTagPreAttrName verb + hasAttributed + tag + "/" + tail + onezero + purs + path + purs + path + trailing else instance ( Sym.Cons q r tail , PXBody verb q r (RL.Cons "0" "0" onezero) pursi pathi purso patho trailing , Sym.Cons x y trailing , PreEndTagFromTrailing x y tag newTrailing ) => - PXTagPreAttrName verb hasAttributed tag ">" tail onezero pursi pathi purso patho newTrailing + PXTagPreAttrName verb + hasAttributed + tag + ">" + tail + onezero + pursi + pathi + purso + patho + newTrailing else instance ( Sym.Cons x y tail - , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrName verb hasAttributed tag " " tail onezero pursi pathi purso patho trailing + PXTagPreAttrName verb + hasAttributed + tag + " " + tail + onezero + pursi + pathi + purso + patho + trailing else instance ( Sym.Cons x y tail - , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrName verb hasAttributed tag "\t" tail onezero pursi pathi purso patho trailing + PXTagPreAttrName verb + hasAttributed + tag + "\t" + tail + onezero + pursi + pathi + purso + patho + trailing else instance ( Sym.Cons x y tail - , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrName verb hasAttributed tag "\n" tail onezero pursi pathi purso patho trailing + PXTagPreAttrName verb + hasAttributed + tag + "\n" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "a" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "a" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "a" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "a" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "b" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "b" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "b" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "b" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "c" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "c" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "c" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "c" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "d" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "d" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "d" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "d" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "e" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "e" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "e" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "e" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "f" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "f" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "f" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "f" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "g" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "g" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "g" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "g" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "h" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "h" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "h" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "h" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "i" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "i" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "i" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "i" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "j" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "j" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "j" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "j" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "k" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "k" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "k" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "k" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "l" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "l" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "l" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "l" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "m" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "m" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "m" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "m" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "n" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "n" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "n" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "n" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "o" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "o" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "o" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "o" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "p" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "p" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "p" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "p" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "q" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "q" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "q" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "q" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "r" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "r" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "r" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "r" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "s" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "s" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "s" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "s" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "t" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "t" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "t" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "t" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "u" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "u" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "u" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "u" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "v" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "v" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "v" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "v" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "w" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "w" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "w" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "w" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "x" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "x" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "x" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "x" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "y" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "y" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "y" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "y" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "z" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "z" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "z" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "z" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "A" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "A" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "A" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "A" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "B" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "B" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "B" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "B" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "C" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "C" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "C" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "C" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "D" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "D" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "D" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "D" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "E" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "E" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "E" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "E" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "F" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "F" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "F" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "F" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "G" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "G" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "G" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "G" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "H" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "H" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "H" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "H" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "I" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "I" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "I" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "I" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "J" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "J" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "J" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "J" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "K" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "K" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "K" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "K" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "L" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "L" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "L" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "L" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "M" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "M" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "M" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "M" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "N" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "N" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "N" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "N" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "O" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "O" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "O" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "O" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "P" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "P" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "P" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "P" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "Q" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "Q" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "Q" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "Q" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "R" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "R" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "R" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "R" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "S" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "S" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "S" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "S" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "T" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "T" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "T" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "T" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "U" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "U" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "U" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "U" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "V" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "V" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "V" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "V" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "W" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "W" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "W" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "W" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "X" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "X" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "X" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "X" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "Y" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "Y" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "Y" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "Y" + tail + onezero + pursi + pathi + purso + patho + trailing else instance - PXTagAttrName verb hasAttributed tag "Z" tail onezero pursi pathi purso patho trailing => - PXTagPreAttrName verb hasAttributed tag "Z" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb hasAttributed tag "Z" tail onezero pursi pathi purso patho + trailing => + PXTagPreAttrName verb + hasAttributed + tag + "Z" + tail + onezero + pursi + pathi + purso + patho + trailing else instance ( Sym.Cons x y tail , DoVerbForAttr verb tag "" x y onezero pursi pathi pursx pathx newTail , Sym.Cons xx yy newTail - , PXTagPreAttrName verb True tag xx yy onezero pursx pathx purso patho trailing + , PXTagPreAttrName verb True tag xx yy onezero pursx pathx purso patho + trailing ) => - PXTagPreAttrName verb False tag verb tail onezero pursi pathi purso patho trailing + PXTagPreAttrName verb + False + tag + verb + tail + onezero + pursi + pathi + purso + patho + trailing -- class @@ -1073,405 +1823,1142 @@ class instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "a" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "a" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "b" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "b" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "c" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "c" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "d" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "d" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "e" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "e" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "f" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "f" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "g" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "g" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "h" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "h" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "i" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "i" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "j" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "j" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "k" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "k" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "l" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "l" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "m" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "m" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "n" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "n" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "o" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "o" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "p" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "p" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "q" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "q" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "r" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "r" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "s" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "s" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "t" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "t" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "u" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "u" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "v" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "v" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "w" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "w" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "x" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "x" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "y" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "y" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "z" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "z" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "A" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "A" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "B" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "B" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "C" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "C" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "D" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "D" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "E" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "E" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "F" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "F" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "G" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "G" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "H" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "H" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "I" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "I" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "J" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "J" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "K" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "K" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "L" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "L" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "M" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "M" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "N" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "N" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "O" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "O" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "P" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "P" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "Q" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "Q" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "R" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "R" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "S" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "S" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "T" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "T" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "U" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "U" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "V" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "V" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "W" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "W" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "X" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "X" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "Y" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "Y" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "Z" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "Z" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "-" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "-" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "0" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "0" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "1" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "1" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "2" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "2" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "3" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "3" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "4" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "4" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "5" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "5" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "6" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "6" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "7" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "7" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "8" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "8" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "9" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "9" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag " " tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + " " + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "\t" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "\t" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "\n" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "\n" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagAttrName verb hasAttributed tag "=" tail onezero pursi pathi purso patho trailing + PXTagAttrName verb + hasAttributed + tag + "=" + tail + onezero + pursi + pathi + purso + patho + trailing -- class @@ -1491,27 +2978,71 @@ class instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPostAttrName verb hasAttributed tag " " tail onezero pursi pathi purso patho trailing + PXTagPostAttrName verb + hasAttributed + tag + " " + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPostAttrName verb hasAttributed tag "\t" tail onezero pursi pathi purso patho trailing + PXTagPostAttrName verb + hasAttributed + tag + "\t" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPostAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPostAttrName verb hasAttributed tag "\n" tail onezero pursi pathi purso patho trailing + PXTagPostAttrName verb + hasAttributed + tag + "\n" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPostAttrName verb hasAttributed tag "=" tail onezero pursi pathi purso patho trailing + PXTagPostAttrName verb + hasAttributed + tag + "=" + tail + onezero + pursi + pathi + purso + patho + trailing -- class @@ -1531,35 +3062,94 @@ class instance ( Sym.Cons x y tail - , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrValue verb hasAttributed tag " " tail onezero pursi pathi purso patho trailing + PXTagPreAttrValue verb + hasAttributed + tag + " " + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrValue verb hasAttributed tag "\t" tail onezero pursi pathi purso patho trailing + PXTagPreAttrValue verb + hasAttributed + tag + "\t" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrValue verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => - PXTagPreAttrValue verb hasAttributed tag "\n" tail onezero pursi pathi purso patho trailing + PXTagPreAttrValue verb + hasAttributed + tag + "\n" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => - PXTagPreAttrValue verb hasAttributed tag "\"" tail onezero pursi pathi purso patho trailing + PXTagPreAttrValue verb + hasAttributed + tag + "\"" + tail + onezero + pursi + pathi + purso + patho + trailing instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => - PXTagPreAttrValue verb hasAttributed tag "'" tail onezero pursi pathi purso patho trailing + PXTagPreAttrValue verb + hasAttributed + tag + "'" + tail + onezero + pursi + pathi + purso + patho + trailing -- class @@ -1579,7 +3169,10 @@ class instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1596,7 +3189,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1613,7 +3209,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1630,7 +3229,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1647,7 +3249,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1664,7 +3269,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1681,7 +3289,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1698,7 +3309,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1715,7 +3329,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1732,7 +3349,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1749,7 +3369,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1766,7 +3389,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1783,7 +3409,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1800,7 +3429,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1817,7 +3449,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1834,7 +3469,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1851,7 +3489,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1868,7 +3509,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1885,7 +3529,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1902,7 +3549,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1919,7 +3569,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1936,7 +3589,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1953,7 +3609,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1970,7 +3629,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -1987,7 +3649,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2004,7 +3669,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2021,7 +3689,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2038,7 +3709,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2055,7 +3729,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2072,7 +3749,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2089,7 +3769,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2106,7 +3789,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2123,7 +3809,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2140,7 +3829,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2157,7 +3849,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2174,7 +3869,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2191,7 +3889,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2208,7 +3909,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2225,7 +3929,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2242,7 +3949,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2259,7 +3969,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2276,7 +3989,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2293,7 +4009,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2310,7 +4029,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2327,7 +4049,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2344,7 +4069,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2361,7 +4089,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2378,7 +4109,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2395,7 +4129,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2412,7 +4149,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2429,7 +4169,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2446,7 +4189,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2463,7 +4209,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2480,7 +4229,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2497,7 +4249,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2514,7 +4269,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2531,7 +4289,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2548,7 +4309,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2565,7 +4329,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2582,7 +4349,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2599,7 +4369,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2616,7 +4389,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2633,7 +4409,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2650,7 +4429,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2667,7 +4449,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2684,7 +4469,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2701,7 +4489,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2718,7 +4509,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2735,7 +4529,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2752,7 +4549,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2769,7 +4569,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2786,7 +4589,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2803,7 +4609,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2820,7 +4629,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2837,7 +4649,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2854,7 +4669,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2871,7 +4689,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2888,7 +4709,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2905,7 +4729,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2922,7 +4749,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2939,7 +4769,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2956,7 +4789,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2973,7 +4809,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -2990,7 +4829,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3007,7 +4849,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3024,7 +4869,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3041,7 +4889,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3058,7 +4909,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3075,7 +4929,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3092,7 +4949,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithDoubleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithDoubleQuote verb @@ -3124,7 +4984,10 @@ class instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3141,7 +5004,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3158,7 +5024,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3175,7 +5044,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3192,7 +5064,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3209,7 +5084,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3226,7 +5104,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3243,7 +5124,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3260,7 +5144,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3277,7 +5164,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3294,7 +5184,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3311,7 +5204,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3328,7 +5224,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3345,7 +5244,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3362,7 +5264,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3379,7 +5284,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3396,7 +5304,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3413,7 +5324,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3430,7 +5344,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3447,7 +5364,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3464,7 +5384,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3481,7 +5404,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3498,7 +5424,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3515,7 +5444,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3532,7 +5464,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3549,7 +5484,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3566,7 +5504,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3583,7 +5524,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3600,7 +5544,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3617,7 +5564,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3634,7 +5584,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3651,7 +5604,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3668,7 +5624,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3685,7 +5644,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3702,7 +5664,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3719,7 +5684,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3736,7 +5704,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3753,7 +5724,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3770,7 +5744,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3787,7 +5764,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3804,7 +5784,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3821,7 +5804,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3838,7 +5824,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3855,7 +5844,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3872,7 +5864,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3889,7 +5884,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3906,7 +5904,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3923,7 +5924,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3940,7 +5944,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3957,7 +5964,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3974,7 +5984,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -3991,7 +6004,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4008,7 +6024,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4025,7 +6044,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4042,7 +6064,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4059,7 +6084,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4076,7 +6104,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4093,7 +6124,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4110,7 +6144,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4127,7 +6164,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4144,7 +6184,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4161,7 +6204,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4178,7 +6224,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4195,7 +6244,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4212,7 +6264,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4229,7 +6284,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4246,7 +6304,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4263,7 +6324,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4280,7 +6344,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4297,7 +6364,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4314,7 +6384,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4331,7 +6404,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4348,7 +6424,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4365,7 +6444,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4382,7 +6464,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4399,7 +6484,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4416,7 +6504,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4433,7 +6524,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4450,7 +6544,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4467,7 +6564,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4484,7 +6584,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4501,7 +6604,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4518,7 +6624,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4535,7 +6644,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4552,7 +6664,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4569,7 +6684,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4586,7 +6704,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4603,7 +6724,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4620,7 +6744,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4637,7 +6764,10 @@ instance instance ( Sym.Cons x y tail - , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi pathi purso patho + , PXTagAttrValueWithWithSingleQuote verb hasAttributed tag x y onezero pursi + pathi + purso + patho trailing ) => PXTagAttrValueWithWithSingleQuote verb @@ -4654,7 +6784,8 @@ instance instance ( Sym.Cons x y tail - , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => PXTagAttrValueWithWithDoubleQuote verb hasAttributed @@ -4670,7 +6801,8 @@ instance instance ( Sym.Cons x y tail - , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho trailing + , PXTagPreAttrName verb hasAttributed tag x y onezero pursi pathi purso patho + trailing ) => PXTagAttrValueWithWithSingleQuote verb hasAttributed @@ -4766,7 +6898,8 @@ else instance , Row.Union pursi pursm pursz , Row.Union pathi pathm pathz , Sym.Cons x y trailing - , PXBody verb x y (RL.Cons "1" "1" onezero) pursz pathz purso patho newTrailing + , PXBody verb x y (RL.Cons "1" "1" onezero) pursz pathz purso patho + newTrailing ) => CloseOrRepeat verb anything tail onezero pursi pathi purso patho newTrailing diff --git a/deku-core/src/Deku/Toplevel.purs b/deku-core/src/Deku/Toplevel.purs index 176c4fc4..8c715405 100644 --- a/deku-core/src/Deku/Toplevel.purs +++ b/deku-core/src/Deku/Toplevel.purs @@ -25,18 +25,19 @@ import Web.HTML.Window (document) runInElement :: Web.DOM.Element -> Nut - -> Effect ( Effect Unit ) + -> Effect (Effect Unit) runInElement elt (Nut nut) = do - { poll : lifecycle, push : dispose } <- liftST create - region <- liftST $ runSTFn1 Region.fromParent ( DekuParent $ toDekuElement elt ) - void $ runEffectFn2 nut ( PSR { region, unsubs: [], lifecycle } ) fullDOMInterpret + { poll: lifecycle, push: dispose } <- liftST create + region <- liftST $ runSTFn1 Region.fromParent (DekuParent $ toDekuElement elt) + void $ runEffectFn2 nut (PSR { region, unsubs: [], lifecycle }) + fullDOMInterpret pure $ dispose unit -- | Runs a deku application in the body of a document, returning a canceler that can -- | be used to cancel the application. runInBody :: Nut - -> Effect ( Effect Unit ) + -> Effect (Effect Unit) runInBody elt = do b' <- window >>= document >>= body maybe (throwException (error "Could not find element")) diff --git a/deku-core/src/Deku/UnsafeDOM.purs b/deku-core/src/Deku/UnsafeDOM.purs index 5a875d1b..9ee3737c 100644 --- a/deku-core/src/Deku/UnsafeDOM.purs +++ b/deku-core/src/Deku/UnsafeDOM.purs @@ -18,10 +18,10 @@ foreign import createText :: EffectFn1 String Text foreign import setTextContent :: EffectFn2 String Node Unit foreign import pushCb :: EffectFn3 String EventListener Element Unit -foreign import popCb :: EffectFn2 String Element ( Nullable EventListener ) +foreign import popCb :: EffectFn2 String Element (Nullable EventListener) -foreign import after :: EffectFn2 ( Array Node ) Node Unit -foreign import prepend :: EffectFn2 ( Array Node ) Node Unit +foreign import after :: EffectFn2 (Array Node) Node Unit +foreign import prepend :: EffectFn2 (Array Node) Node Unit foreign import addEventListener :: EffectFn4 EventType