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

This commit is contained in:
fr33domlover 2019-07-23 18:17:15 +00:00
parent 655a2ebe18
commit 072039f5d8

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