From f8f3a31a8d33c0ac82439cf79004c14e4e8f9f46 Mon Sep 17 00:00:00 2001
From: fr33domlover <fr33domlover@riseup.net>
Date: Fri, 14 Jun 2019 17:21:38 +0000
Subject: [PATCH] Yesod.FedURI and Yesod.Hashids switch from MonadHandler to
 MonadSite

---
 src/Yesod/FedURI.hs  | 29 +++++++++++++++--------------
 src/Yesod/Hashids.hs | 34 +++++++++++++++++++---------------
 2 files changed, 34 insertions(+), 29 deletions(-)

diff --git a/src/Yesod/FedURI.hs b/src/Yesod/FedURI.hs
index a38bd55..f9577e6 100644
--- a/src/Yesod/FedURI.hs
+++ b/src/Yesod/FedURI.hs
@@ -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
diff --git a/src/Yesod/Hashids.hs b/src/Yesod/Hashids.hs
index eb814be..e5672a9 100644
--- a/src/Yesod/Hashids.hs
+++ b/src/Yesod/Hashids.hs
@@ -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
        )