29 lines
912 B
Haskell
29 lines
912 B
Haskell
module Utils.Route where
|
|
|
|
import Control.Lens
|
|
import ClassyPrelude.Yesod -- hiding (foldlM)
|
|
|
|
|
|
class RedirectUrl site url => HasRoute site url where
|
|
urlRoute :: url -> Route site
|
|
|
|
instance HasRoute site (Route site) where
|
|
urlRoute = id
|
|
-- | for GET-Parameters
|
|
instance (key ~ Text) => HasRoute site (Route site, Map key Text) where
|
|
urlRoute = view _1
|
|
-- | for GET-Parameters
|
|
instance (key ~ Text) => HasRoute site (Route site, [(key, Text)]) where
|
|
urlRoute = view _1
|
|
-- | for PageAnchors, implemented through Fragments
|
|
instance (HasRoute site a, PathPiece b) => HasRoute site (Fragment a b) where
|
|
urlRoute (a :#: _) = urlRoute a
|
|
|
|
data SomeRoute site = forall url. HasRoute site url => SomeRoute url
|
|
deriving (Typeable)
|
|
|
|
instance RedirectUrl site (SomeRoute site) where
|
|
toTextUrl (SomeRoute url) = toTextUrl url
|
|
instance HasRoute site (SomeRoute site) where
|
|
urlRoute (SomeRoute url) = urlRoute url
|