sup39/vervis
1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2024-12-28 10:04:51 +09:00
Code Issues Activity

On "See JSON" pages, display a link back to "regular HTML" version of the page

Browse source
This commit is contained in:
fr33domlover 2019-07-23 18:17:15 +00:00
parent 655a2ebe18
commit 072039f5d8
1 changed files with 15 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
src/Yesod/ActivityPub.hs
View file

@ -32,6 +32,8 @@ import Data.Aeson
import Data.Aeson.Encode.Pretty import Data.Aeson.Encode.Pretty
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Foldable import Data.Foldable
import Data.Function
import Data.List
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text) import Data.Text (Text)
import Network.HTTP.Client import Network.HTTP.Client
@ -210,6 +212,17 @@ provideHtmlAndAP' host object widget = selectRep $ do
if sky if sky
then renderPrettyJSONSkylighting doc then renderPrettyJSONSkylighting doc
else renderPrettyJSON doc else renderPrettyJSON doc
mroute <- getCurrentRoute
for_ mroute $ \ route -> do
params <- reqGetParams <$> getRequest
let params' =
delete' "prettyjson" $
delete' "highlight" params
[whamlet|
<div>
<a href=@?{(route, params')}>
[See HTML]
|]
_ -> do _ -> do
widget widget
mroute <- getCurrentRoute mroute <- getCurrentRoute
@ -223,6 +236,8 @@ provideHtmlAndAP' host object widget = selectRep $ do
<a href=@?{(route, params')}> <a href=@?{(route, params')}>
[See JSON] [See JSON]
|] |]
where
delete' t = deleteBy ((==) `on` fst) (t, "")
provideHtmlAndAP'' provideHtmlAndAP''
:: Yesod site :: Yesod site