Yesod.FedURI and Yesod.Hashids switch from MonadHandler to MonadSite

This commit is contained in:
fr33domlover 2019-06-14 17:21:38 +00:00
parent 6df2200f47
commit f8f3a31a8d
2 changed files with 34 additions and 29 deletions

View file

@ -36,22 +36,23 @@ import Yesod.Core.Handler
import qualified Data.Text as T
import Network.FedURI
import Yesod.MonadSite
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
getEncodeRouteHome :: MonadHandler m => m (Route (HandlerSite m) -> FedURI)
getEncodeRouteHome = toFed <$> getUrlRender
getEncodeRouteHome :: MonadSite m => m (Route (SiteEnv m) -> FedURI)
getEncodeRouteHome = toFed <$> askUrlRender
where
toFed renderUrl route =
case parseFedURI $ renderUrl route of
Left e -> error $ "getUrlRender produced invalid FedURI: " ++ e
Right u -> u
getEncodeRouteFed :: MonadHandler m => m (Text -> Route (HandlerSite m) -> FedURI)
getEncodeRouteFed = toFed <$> getUrlRender
getEncodeRouteFed :: MonadSite m => m (Text -> Route (SiteEnv m) -> FedURI)
getEncodeRouteFed = toFed <$> askUrlRender
where
toFed renderUrl host route =
case parseFedURI $ renderUrl route of
@ -68,26 +69,26 @@ decodeRouteLocal =
else Nothing
getEncodeRoutePageLocal
:: (MonadHandler m, YesodPaginate (HandlerSite m))
=> m (Route (HandlerSite m) -> Int -> LocalPageURI)
:: (MonadSite m, YesodPaginate (SiteEnv m))
=> m (Route (SiteEnv m) -> Int -> LocalPageURI)
getEncodeRoutePageLocal = do
encodeRouteLocal <- getEncodeRouteLocal
param <- getsYesod sitePageParamName
param <- asksSite sitePageParamName
return $ \ route page -> LocalPageURI (encodeRouteLocal route) param page
getEncodeRoutePageHome
:: (MonadHandler m, YesodPaginate (HandlerSite m))
=> m (Route (HandlerSite m) -> Int -> FedPageURI)
:: (MonadSite m, YesodPaginate (SiteEnv m))
=> m (Route (SiteEnv m) -> Int -> FedPageURI)
getEncodeRoutePageHome = do
encodeRouteHome <- getEncodeRouteHome
param <- getsYesod sitePageParamName
param <- asksSite sitePageParamName
return $ \ route page -> FedPageURI (encodeRouteHome route) param page
getEncodeRoutePageFed
:: (MonadHandler m, YesodPaginate (HandlerSite m))
=> m (Text -> Route (HandlerSite m) -> Int -> FedPageURI)
:: (MonadSite m, YesodPaginate (SiteEnv m))
=> m (Text -> Route (SiteEnv m) -> Int -> FedPageURI)
getEncodeRoutePageFed = do
encodeRouteFed <- getEncodeRouteFed
param <- getsYesod sitePageParamName
param <- asksSite sitePageParamName
return $
\ host route page -> FedPageURI (encodeRouteFed host route) param page

View file

@ -41,6 +41,8 @@ import Web.PathPieces
import Yesod.Core
import Yesod.Core.Handler
import Yesod.MonadSite
import Web.Hashids.Local
class Yesod site => YesodHashids site where
@ -61,18 +63,18 @@ encodeKeyHashidPure
encodeKeyHashidPure ctx = KeyHashid . decodeUtf8 . encodeInt64 ctx . fromSqlKey
getEncodeKeyHashid
:: ( MonadHandler m
, YesodHashids (HandlerSite m)
:: ( MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> m (Key record -> KeyHashid record)
getEncodeKeyHashid = do
ctx <- getsYesod siteHashidsContext
ctx <- asksSite siteHashidsContext
return $ encodeKeyHashidPure ctx
encodeKeyHashid
:: ( MonadHandler m
, YesodHashids (HandlerSite m)
:: ( MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> Key record
@ -82,20 +84,20 @@ encodeKeyHashid k = do
return $ enc k
decodeKeyHashid
:: ( MonadHandler m
, YesodHashids (HandlerSite m)
:: ( MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> KeyHashid record
-> m (Maybe (Key record))
decodeKeyHashid (KeyHashid t) = do
ctx <- getsYesod siteHashidsContext
ctx <- asksSite siteHashidsContext
return $ fmap toSqlKey $ decodeInt64 ctx $ encodeUtf8 t
decodeKeyHashidF
:: ( MonadFail m
, MonadHandler m
, YesodHashids (HandlerSite m)
, MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> KeyHashid record
@ -104,8 +106,8 @@ decodeKeyHashidF
decodeKeyHashidF khid e = maybe (fail e) return =<< decodeKeyHashid khid
decodeKeyHashidM
:: ( MonadHandler m
, YesodHashids (HandlerSite m)
:: ( MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> KeyHashid record
@ -113,8 +115,8 @@ decodeKeyHashidM
decodeKeyHashidM = MaybeT . decodeKeyHashid
decodeKeyHashidE
:: ( MonadHandler m
, YesodHashids (HandlerSite m)
:: ( MonadSite m
, YesodHashids (SiteEnv m)
, ToBackendKey SqlBackend record
)
=> KeyHashid record
@ -124,7 +126,9 @@ decodeKeyHashidE khid e =
ExceptT $ maybe (Left e) Right <$> decodeKeyHashid khid
decodeKeyHashid404
:: ( MonadHandler m
:: ( MonadSite m
, MonadHandler m
, HandlerSite m ~ SiteEnv m
, YesodHashids (HandlerSite m)
, ToBackendKey SqlBackend record
)