sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-29 02:44:53 +09:00
Code Issues Activity

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

29
src/Yesod/FedURI.hs
View file

@ -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

34
src/Yesod/Hashids.hs
View file

@ -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
) )