Yesod.FedURI and Yesod.Hashids switch from MonadHandler to MonadSite
This commit is contained in:
parent
6df2200f47
commit
f8f3a31a8d
2 changed files with 34 additions and 29 deletions
|
@ -36,22 +36,23 @@ import Yesod.Core.Handler
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
import Network.FedURI
|
import Network.FedURI
|
||||||
|
import Yesod.MonadSite
|
||||||
|
|
||||||
import Yesod.Paginate.Local
|
import Yesod.Paginate.Local
|
||||||
|
|
||||||
getEncodeRouteLocal :: MonadHandler m => m (Route (HandlerSite m) -> LocalURI)
|
getEncodeRouteLocal :: MonadSite m => m (Route (SiteEnv m) -> LocalURI)
|
||||||
getEncodeRouteLocal = (\ f -> snd . f2l . f) <$> getEncodeRouteHome
|
getEncodeRouteLocal = (\ f -> snd . f2l . f) <$> getEncodeRouteHome
|
||||||
|
|
||||||
getEncodeRouteHome :: MonadHandler m => m (Route (HandlerSite m) -> FedURI)
|
getEncodeRouteHome :: MonadSite m => m (Route (SiteEnv m) -> FedURI)
|
||||||
getEncodeRouteHome = toFed <$> getUrlRender
|
getEncodeRouteHome = toFed <$> askUrlRender
|
||||||
where
|
where
|
||||||
toFed renderUrl route =
|
toFed renderUrl route =
|
||||||
case parseFedURI $ renderUrl route of
|
case parseFedURI $ renderUrl route of
|
||||||
Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
|
Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
|
||||||
Right u -> u
|
Right u -> u
|
||||||
|
|
||||||
getEncodeRouteFed :: MonadHandler m => m (Text -> Route (HandlerSite m) -> FedURI)
|
getEncodeRouteFed :: MonadSite m => m (Text -> Route (SiteEnv m) -> FedURI)
|
||||||
getEncodeRouteFed = toFed <$> getUrlRender
|
getEncodeRouteFed = toFed <$> askUrlRender
|
||||||
where
|
where
|
||||||
toFed renderUrl host route =
|
toFed renderUrl host route =
|
||||||
case parseFedURI $ renderUrl route of
|
case parseFedURI $ renderUrl route of
|
||||||
|
@ -68,26 +69,26 @@ decodeRouteLocal =
|
||||||
else Nothing
|
else Nothing
|
||||||
|
|
||||||
getEncodeRoutePageLocal
|
getEncodeRoutePageLocal
|
||||||
:: (MonadHandler m, YesodPaginate (HandlerSite m))
|
:: (MonadSite m, YesodPaginate (SiteEnv m))
|
||||||
=> m (Route (HandlerSite m) -> Int -> LocalPageURI)
|
=> m (Route (SiteEnv m) -> Int -> LocalPageURI)
|
||||||
getEncodeRoutePageLocal = do
|
getEncodeRoutePageLocal = do
|
||||||
encodeRouteLocal <- getEncodeRouteLocal
|
encodeRouteLocal <- getEncodeRouteLocal
|
||||||
param <- getsYesod sitePageParamName
|
param <- asksSite sitePageParamName
|
||||||
return $ \ route page -> LocalPageURI (encodeRouteLocal route) param page
|
return $ \ route page -> LocalPageURI (encodeRouteLocal route) param page
|
||||||
|
|
||||||
getEncodeRoutePageHome
|
getEncodeRoutePageHome
|
||||||
:: (MonadHandler m, YesodPaginate (HandlerSite m))
|
:: (MonadSite m, YesodPaginate (SiteEnv m))
|
||||||
=> m (Route (HandlerSite m) -> Int -> FedPageURI)
|
=> m (Route (SiteEnv m) -> Int -> FedPageURI)
|
||||||
getEncodeRoutePageHome = do
|
getEncodeRoutePageHome = do
|
||||||
encodeRouteHome <- getEncodeRouteHome
|
encodeRouteHome <- getEncodeRouteHome
|
||||||
param <- getsYesod sitePageParamName
|
param <- asksSite sitePageParamName
|
||||||
return $ \ route page -> FedPageURI (encodeRouteHome route) param page
|
return $ \ route page -> FedPageURI (encodeRouteHome route) param page
|
||||||
|
|
||||||
getEncodeRoutePageFed
|
getEncodeRoutePageFed
|
||||||
:: (MonadHandler m, YesodPaginate (HandlerSite m))
|
:: (MonadSite m, YesodPaginate (SiteEnv m))
|
||||||
=> m (Text -> Route (HandlerSite m) -> Int -> FedPageURI)
|
=> m (Text -> Route (SiteEnv m) -> Int -> FedPageURI)
|
||||||
getEncodeRoutePageFed = do
|
getEncodeRoutePageFed = do
|
||||||
encodeRouteFed <- getEncodeRouteFed
|
encodeRouteFed <- getEncodeRouteFed
|
||||||
param <- getsYesod sitePageParamName
|
param <- asksSite sitePageParamName
|
||||||
return $
|
return $
|
||||||
\ host route page -> FedPageURI (encodeRouteFed host route) param page
|
\ host route page -> FedPageURI (encodeRouteFed host route) param page
|
||||||
|
|
|
@ -41,6 +41,8 @@ import Web.PathPieces
|
||||||
import Yesod.Core
|
import Yesod.Core
|
||||||
import Yesod.Core.Handler
|
import Yesod.Core.Handler
|
||||||
|
|
||||||
|
import Yesod.MonadSite
|
||||||
|
|
||||||
import Web.Hashids.Local
|
import Web.Hashids.Local
|
||||||
|
|
||||||
class Yesod site => YesodHashids site where
|
class Yesod site => YesodHashids site where
|
||||||
|
@ -61,18 +63,18 @@ encodeKeyHashidPure
|
||||||
encodeKeyHashidPure ctx = KeyHashid . decodeUtf8 . encodeInt64 ctx . fromSqlKey
|
encodeKeyHashidPure ctx = KeyHashid . decodeUtf8 . encodeInt64 ctx . fromSqlKey
|
||||||
|
|
||||||
getEncodeKeyHashid
|
getEncodeKeyHashid
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> m (Key record -> KeyHashid record)
|
=> m (Key record -> KeyHashid record)
|
||||||
getEncodeKeyHashid = do
|
getEncodeKeyHashid = do
|
||||||
ctx <- getsYesod siteHashidsContext
|
ctx <- asksSite siteHashidsContext
|
||||||
return $ encodeKeyHashidPure ctx
|
return $ encodeKeyHashidPure ctx
|
||||||
|
|
||||||
encodeKeyHashid
|
encodeKeyHashid
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> Key record
|
=> Key record
|
||||||
|
@ -82,20 +84,20 @@ encodeKeyHashid k = do
|
||||||
return $ enc k
|
return $ enc k
|
||||||
|
|
||||||
decodeKeyHashid
|
decodeKeyHashid
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> KeyHashid record
|
=> KeyHashid record
|
||||||
-> m (Maybe (Key record))
|
-> m (Maybe (Key record))
|
||||||
decodeKeyHashid (KeyHashid t) = do
|
decodeKeyHashid (KeyHashid t) = do
|
||||||
ctx <- getsYesod siteHashidsContext
|
ctx <- asksSite siteHashidsContext
|
||||||
return $ fmap toSqlKey $ decodeInt64 ctx $ encodeUtf8 t
|
return $ fmap toSqlKey $ decodeInt64 ctx $ encodeUtf8 t
|
||||||
|
|
||||||
decodeKeyHashidF
|
decodeKeyHashidF
|
||||||
:: ( MonadFail m
|
:: ( MonadFail m
|
||||||
, MonadHandler m
|
, MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> KeyHashid record
|
=> KeyHashid record
|
||||||
|
@ -104,8 +106,8 @@ decodeKeyHashidF
|
||||||
decodeKeyHashidF khid e = maybe (fail e) return =<< decodeKeyHashid khid
|
decodeKeyHashidF khid e = maybe (fail e) return =<< decodeKeyHashid khid
|
||||||
|
|
||||||
decodeKeyHashidM
|
decodeKeyHashidM
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> KeyHashid record
|
=> KeyHashid record
|
||||||
|
@ -113,8 +115,8 @@ decodeKeyHashidM
|
||||||
decodeKeyHashidM = MaybeT . decodeKeyHashid
|
decodeKeyHashidM = MaybeT . decodeKeyHashid
|
||||||
|
|
||||||
decodeKeyHashidE
|
decodeKeyHashidE
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (SiteEnv m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
=> KeyHashid record
|
=> KeyHashid record
|
||||||
|
@ -124,7 +126,9 @@ decodeKeyHashidE khid e =
|
||||||
ExceptT $ maybe (Left e) Right <$> decodeKeyHashid khid
|
ExceptT $ maybe (Left e) Right <$> decodeKeyHashid khid
|
||||||
|
|
||||||
decodeKeyHashid404
|
decodeKeyHashid404
|
||||||
:: ( MonadHandler m
|
:: ( MonadSite m
|
||||||
|
, MonadHandler m
|
||||||
|
, HandlerSite m ~ SiteEnv m
|
||||||
, YesodHashids (HandlerSite m)
|
, YesodHashids (HandlerSite m)
|
||||||
, ToBackendKey SqlBackend record
|
, ToBackendKey SqlBackend record
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in a new issue