@@ -11,78 +11,73 @@ module Routing.Hash
1111
1212import Prelude
1313
14- import Control.Monad.Eff (Eff )
15- import Control.Monad.Eff.Ref (newRef , readRef , writeRef )
16- import DOM (DOM )
17- import DOM.Event.EventTarget (addEventListener , eventListener , removeEventListener )
18- import DOM.HTML (window )
19- import DOM.HTML.Event.EventTypes (hashchange )
20- import DOM.HTML.Location as L
21- import DOM.HTML.Types (windowToEventTarget )
22- import DOM.HTML.Window (location )
2314import Data.Foldable (class Foldable , indexl )
2415import Data.Maybe (Maybe (..), fromMaybe , maybe )
2516import Data.String (Pattern (..), stripPrefix )
26- import Routing (RoutingEffects , match , matchWith )
17+ import Effect (Effect )
18+ import Effect.Ref as Ref
19+ import Routing (match , matchWith )
2720import Routing.Match (Match )
21+ import Web.Event.EventTarget (addEventListener , eventListener , removeEventListener )
22+ import Web.HTML (window )
23+ import Web.HTML.Event.HashChangeEvent.EventTypes as ET
24+ import Web.HTML.Location as L
25+ import Web.HTML.Window as Window
2826
2927-- | Gets the global location hash.
30- getHash :: forall eff . Eff ( dom :: DOM | eff ) String
31- getHash = window >>= location >>= L .hash >>> map (stripPrefix (Pattern " #" ) >>> fromMaybe " " )
28+ getHash :: Effect String
29+ getHash = window >>= Window . location >>= L .hash >>> map (stripPrefix (Pattern " #" ) >>> fromMaybe " " )
3230
3331-- | Sets the global location hash.
34- setHash :: forall eff . String -> Eff ( dom :: DOM | eff ) Unit
35- setHash h = window >>= location >>= L .setHash h
32+ setHash :: String -> Effect Unit
33+ setHash h = window >>= Window . location >>= L .setHash h
3634
3735-- | Modifies the global location hash.
38- modifyHash :: forall eff . (String -> String ) -> Eff ( dom :: DOM | eff ) Unit
36+ modifyHash :: (String -> String ) -> Effect Unit
3937modifyHash fn = (fn <$> getHash) >>= setHash
4038
4139-- | Folds effectfully over hash changes given a callback and an initial hash.
4240-- | The provided String is the hash portion of the `Location` with the '#'
4341-- | prefix stripped. Returns an effect which will remove the listener.
4442foldHashes
45- :: forall eff a
46- . (a -> String -> Eff ( RoutingEffects eff ) a )
47- -> (String -> Eff ( RoutingEffects eff ) a )
48- -> Eff ( RoutingEffects eff ) ( Eff ( RoutingEffects eff ) Unit )
43+ :: forall a
44+ . (a -> String -> Effect a )
45+ -> (String -> Effect a )
46+ -> Effect ( Effect Unit )
4947foldHashes cb init = do
50- ref <- newRef =<< init =<< getHash
51- win <- windowToEventTarget <$> window
52- let listener = eventListener \_ -> writeRef ref =<< join (cb <$> readRef ref <*> getHash)
53- addEventListener hashchange listener false win
54- pure $ removeEventListener hashchange listener false win
48+ ref <- Ref .new =<< init =<< getHash
49+ win <- Window .toEventTarget <$> window
50+ listener <- eventListener \_ -> flip Ref .write ref =<< join (cb <$> Ref .read ref <*> getHash)
51+ addEventListener ET . hashchange listener false win
52+ pure $ removeEventListener ET . hashchange listener false win
5553
5654-- | Runs the callback on every hash change providing the previous hash and the
5755-- | latest hash. The provided String is the hash portion of the `Location` with
5856-- | the '#' prefix stripped. Returns an effect which will remove the listener.
59- hashes
60- :: forall eff
61- . (Maybe String -> String -> Eff (RoutingEffects eff ) Unit )
62- -> Eff (RoutingEffects eff ) (Eff (RoutingEffects eff ) Unit )
57+ hashes :: (Maybe String -> String -> Effect Unit ) -> Effect (Effect Unit )
6358hashes = matchesWith Just
6459
6560-- | Runs the callback on every hash change using a given `Match` parser to
6661-- | extract a route from the hash. If a hash fails to parse, it is ignored.
6762-- | To avoid dropping hashes, provide a fallback alternative in your parser.
6863-- | Returns an effect which will remove the listener.
6964matches
70- :: forall eff a
65+ :: forall a
7166 . Match a
72- -> (Maybe a -> a -> Eff ( RoutingEffects eff ) Unit )
73- -> Eff ( RoutingEffects eff ) ( Eff ( RoutingEffects eff ) Unit )
67+ -> (Maybe a -> a -> Effect Unit )
68+ -> Effect ( Effect Unit )
7469matches = matchesWith <<< match
7570
7671-- | Runs the callback on every hash change using a given custom parser to
7772-- | extract a route from the hash. If a hash fails to parse, it is ignored.
7873-- | To avoid dropping hashes, provide a fallback alternative in your parser.
7974-- | Returns an effect which will remove the listener.
8075matchesWith
81- :: forall eff f a
76+ :: forall f a
8277 . Foldable f
8378 => (String -> f a )
84- -> (Maybe a -> a -> Eff ( RoutingEffects eff ) Unit )
85- -> Eff ( RoutingEffects eff ) ( Eff ( RoutingEffects eff ) Unit )
79+ -> (Maybe a -> a -> Effect Unit )
80+ -> Effect ( Effect Unit )
8681matchesWith parser cb = foldHashes go (go Nothing )
8782 where
8883 go a =
0 commit comments