On "See JSON" pages, display a link back to "regular HTML" version of the page
This commit is contained in:
parent
655a2ebe18
commit
072039f5d8
1 changed files with 15 additions and 0 deletions
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue