diff --git a/src/Vervis/MediaType.hs b/src/Data/MediaType.hs similarity index 99% rename from src/Vervis/MediaType.hs rename to src/Data/MediaType.hs index 1bf237f..5ad3f15 100644 --- a/src/Vervis/MediaType.hs +++ b/src/Data/MediaType.hs @@ -16,7 +16,7 @@ -- | File content types and tools for detecting them. The focus is on content -- that gets special treatment in Vervis, and not general MIME type modeling or -- detection (although that could be done in the future). -module Vervis.MediaType +module Data.MediaType ( MediaType (..) , FileName , FileBaseName diff --git a/src/Vervis/Handler/Discussion.hs b/src/Vervis/Handler/Discussion.hs index e38b842..faf4170 100644 --- a/src/Vervis/Handler/Discussion.hs +++ b/src/Vervis/Handler/Discussion.hs @@ -61,7 +61,7 @@ import Vervis.Federation import Vervis.Foundation import Vervis.Model import Vervis.Model.Ident -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings import Vervis.Widget.Discussion diff --git a/src/Vervis/Handler/Inbox.hs b/src/Vervis/Handler/Inbox.hs index 85253ef..b76e997 100644 --- a/src/Vervis/Handler/Inbox.hs +++ b/src/Vervis/Handler/Inbox.hs @@ -115,7 +115,7 @@ import Vervis.Model import Vervis.Model.Ident import Vervis.Paginate import Vervis.RemoteActorStore -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings getInboxR :: Handler Html diff --git a/src/Vervis/Handler/Repo.hs b/src/Vervis/Handler/Repo.hs index bf6a0b9..ee34df7 100644 --- a/src/Vervis/Handler/Repo.hs +++ b/src/Vervis/Handler/Repo.hs @@ -86,13 +86,13 @@ import Vervis.Foundation import Vervis.Handler.Repo.Darcs import Vervis.Handler.Repo.Git import Vervis.Path -import Vervis.MediaType (chooseMediaType) +import Data.MediaType import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Paginate import Vervis.Readme -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings import Vervis.SourceTree import Vervis.Style diff --git a/src/Vervis/Handler/Repo/Darcs.hs b/src/Vervis/Handler/Repo/Darcs.hs index 7d70226..7af4a06 100644 --- a/src/Vervis/Handler/Repo/Darcs.hs +++ b/src/Vervis/Handler/Repo/Darcs.hs @@ -54,14 +54,14 @@ import Vervis.ChangeFeed (changeFeed) import Vervis.Form.Repo import Vervis.Foundation import Vervis.Path -import Vervis.MediaType (chooseMediaType) +import Data.MediaType import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Paginate import Vervis.Patch import Vervis.Readme -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings import Vervis.SourceTree import Vervis.Style diff --git a/src/Vervis/Handler/Repo/Git.hs b/src/Vervis/Handler/Repo/Git.hs index 519e21c..3f81a3f 100644 --- a/src/Vervis/Handler/Repo/Git.hs +++ b/src/Vervis/Handler/Repo/Git.hs @@ -64,14 +64,14 @@ import Vervis.ChangeFeed (changeFeed) import Vervis.Form.Repo import Vervis.Foundation import Vervis.Path -import Vervis.MediaType (chooseMediaType) +import Data.MediaType import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Paginate import Vervis.Patch import Vervis.Readme -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings import Vervis.SourceTree import Vervis.Style diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 646546f..3471176 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -105,12 +105,12 @@ import Vervis.Form.Ticket import Vervis.Foundation import Vervis.Handler.Discussion import Vervis.GraphProxy (ticketDepGraph) -import Vervis.MediaType (MediaType (Markdown)) +import Data.MediaType import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Ticket import Vervis.Model.Workflow -import Vervis.Render +import Yesod.RenderSource import Vervis.Settings import Vervis.Style import Vervis.Ticket diff --git a/src/Vervis/Handler/Wiki.hs b/src/Vervis/Handler/Wiki.hs index d09c676..2a765bd 100644 --- a/src/Vervis/Handler/Wiki.hs +++ b/src/Vervis/Handler/Wiki.hs @@ -33,12 +33,12 @@ import Yesod.Persist.Core (runDB, getBy404) import Text.FilePath.Local (breakExt) import Vervis.Darcs import Vervis.Foundation -import Vervis.MediaType +import Data.MediaType import Vervis.Model import Vervis.Model.Ident import Vervis.Model.Repo import Vervis.Path (askRepoDir) -import Vervis.Render (renderSourceBL) +import Yesod.RenderSource import Vervis.Settings (widgetFile) import Vervis.Wiki diff --git a/src/Vervis/Migration.hs b/src/Vervis/Migration.hs index 21f892e..e00f662 100644 --- a/src/Vervis/Migration.hs +++ b/src/Vervis/Migration.hs @@ -66,7 +66,7 @@ import Database.Persist.Local import Vervis.Model.Ident import Vervis.Foundation (Route (..)) import Vervis.Migration.Model -import Vervis.Render +import Yesod.RenderSource instance PersistDefault ByteString where pdef = def diff --git a/src/Vervis/Readme.hs b/src/Vervis/Readme.hs index c5ddd01..e666fac 100644 --- a/src/Vervis/Readme.hs +++ b/src/Vervis/Readme.hs @@ -33,8 +33,8 @@ import System.FilePath (isExtSeparator) import Data.Git.Local (TreeRows) import Text.FilePath.Local (breakExt) import Vervis.Foundation (Widget) -import Vervis.MediaType (chooseMediaType) -import Vervis.Render (renderSourceBL) +import Data.MediaType +import Yesod.RenderSource -- | Check if the given filename should be considered as README file. Assumes -- a flat filename which doesn't contain a directory part. diff --git a/src/Vervis/SourceTree.hs b/src/Vervis/SourceTree.hs index c7baada..ac7dcb2 100644 --- a/src/Vervis/SourceTree.hs +++ b/src/Vervis/SourceTree.hs @@ -34,9 +34,9 @@ import qualified Data.ByteString.Lazy as BL (ByteString) import Text.FilePath.Local (breakExt) import Vervis.Foundation (Widget) -import Vervis.MediaType (chooseMediaType) +import Data.MediaType import Vervis.Readme (renderReadme) -import Vervis.Render (renderSourceBL) +import Yesod.RenderSource data EntryType = TypeBlob | TypeTree diff --git a/src/Vervis/Widget/Discussion.hs b/src/Vervis/Widget/Discussion.hs index 637b229..beb15ce 100644 --- a/src/Vervis/Widget/Discussion.hs +++ b/src/Vervis/Widget/Discussion.hs @@ -40,10 +40,10 @@ import Data.Time.Clock.Local () import Vervis.Discussion import Vervis.Foundation -import Vervis.MediaType (MediaType (Markdown)) +import Data.MediaType import Vervis.Model import Vervis.Model.Ident -import Vervis.Render (renderSourceT) +import Yesod.RenderSource import Vervis.Settings (widgetFile) import Vervis.Widget.Sharer diff --git a/src/Vervis/Wiki.hs b/src/Vervis/Wiki.hs index 7ab8f76..fa4e065 100644 --- a/src/Vervis/Wiki.hs +++ b/src/Vervis/Wiki.hs @@ -26,9 +26,9 @@ import qualified Data.ByteString.Lazy as BL (ByteString) import Text.FilePath.Local (breakExt) import Vervis.Foundation (Widget) -import Vervis.MediaType (chooseMediaType) +import Data.MediaType import Vervis.Readme (renderReadme) -import Vervis.Render (renderSourceBL) +import Yesod.RenderSource data WikiView = WikiViewPage (Maybe Text) BL.ByteString diff --git a/src/Yesod/ActivityPub.hs b/src/Yesod/ActivityPub.hs index d689418..fcaf6ca 100644 --- a/src/Yesod/ActivityPub.hs +++ b/src/Yesod/ActivityPub.hs @@ -39,10 +39,10 @@ import qualified Data.Text as T import Network.HTTP.Signature -import Data.Aeson.Encode.Pretty.ToEncoding import Network.FedURI import Web.ActivityPub import Yesod.MonadSite +import Yesod.RenderSource class Yesod site => YesodActivityPub site where siteInstanceHost :: site -> Text @@ -134,10 +134,7 @@ provideHtmlAndAP' host object widget = selectRep $ do mval <- lookupGetParam "prettyjson" defaultLayout $ case mval of - Just "true" -> - [whamlet| -
#{encodePrettyToLazyText doc}
-                    |]
+                Just "true" -> renderPrettyJSON doc
                 _ -> do
                     widget
                     mroute <- getCurrentRoute
diff --git a/src/Vervis/Render.hs b/src/Yesod/RenderSource.hs
similarity index 89%
rename from src/Vervis/Render.hs
rename to src/Yesod/RenderSource.hs
index a56b5e3..174533f 100644
--- a/src/Vervis/Render.hs
+++ b/src/Yesod/RenderSource.hs
@@ -36,10 +36,11 @@
 -- (3) Not implemented
 -- (4) Not implemented
 -- (5) Not implmented
-module Vervis.Render
+module Yesod.RenderSource
     ( renderSourceT
     , renderSourceBL
     , renderPandocMarkdown
+    , renderPrettyJSON
     )
 where
 
@@ -48,6 +49,7 @@ import Prelude
 import Control.Exception
 import Control.Monad.Catch (throwM)
 import Control.Monad.Logger (logDebug, logWarn)
+import Data.Aeson
 import Data.Foldable (for_)
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
@@ -64,7 +66,7 @@ import Text.Pandoc.Highlighting
 import Text.Pandoc.Options
 import Text.Pandoc.Readers.Markdown
 import Text.Pandoc.Writers.HTML
-import Yesod.Core.Widget (whamlet, toWidget)
+import Yesod.Core.Widget
 
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as BL
@@ -74,9 +76,10 @@ import qualified Data.Text.Encoding.Error as TE
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLE
 import qualified Text.Highlighter.Lexers.Haskell as L.Haskell
+import qualified Text.Highlighter.Lexers.Javascript as L.JS
 
-import Vervis.Foundation (Widget)
-import Vervis.MediaType (MediaType (..))
+import Data.Aeson.Encode.Pretty.ToEncoding
+import Data.MediaType
 
 -- * File uploads and wiki attachments
 -- * Wiki pages
@@ -116,20 +119,20 @@ import Vervis.MediaType (MediaType (..))
 -- * [ ] asciidoc
 -- * [ ] groff manpage
 
-renderPlain :: TL.Text -> Widget
+renderPlain :: TL.Text -> WidgetFor site ()
 renderPlain content =
     [whamlet|
         
             #{content}
     |]
 
-renderHighlight :: Lexer -> B.ByteString -> Maybe Widget
+renderHighlight :: Lexer -> B.ByteString -> Maybe (WidgetFor site ())
 renderHighlight lexer content =
     case runLexer lexer content of
         Left err     -> Nothing
         Right tokens -> Just $ toWidget $ format True tokens
 
-renderCode :: Lexer -> TL.Text -> B.ByteString -> Widget
+renderCode :: Lexer -> TL.Text -> B.ByteString -> WidgetFor site ()
 renderCode lexer contentTL contentB =
     fromMaybe (renderPlain contentTL) $ renderHighlight lexer contentB
 
@@ -182,7 +185,7 @@ writerOptions = def
 --  , writerSyntaxMap         = defaultSyntaxMap
     }
 
-renderPandoc :: Pandoc -> Widget
+renderPandoc :: Pandoc -> WidgetFor site ()
 renderPandoc
     = either throwM toWidget
     . fmap
@@ -194,20 +197,21 @@ renderPandoc
     . runPure
     . writeHtml5 writerOptions
 
-renderSourceT :: MediaType -> Text -> Widget
+renderSourceT :: MediaType -> Text -> WidgetFor site ()
 renderSourceT mt contentT =
     let contentB = TE.encodeUtf8 contentT
         contentTL = TL.fromStrict contentT
     in  renderSource mt contentB contentTL contentT
 
-renderSourceBL :: MediaType -> BL.ByteString -> Widget
+renderSourceBL :: MediaType -> BL.ByteString -> WidgetFor site ()
 renderSourceBL mt contentBL =
     let contentB = BL.toStrict contentBL
         contentTL = TLE.decodeUtf8With TE.lenientDecode contentBL
         contentT = TL.toStrict contentTL
     in  renderSource mt contentB contentTL contentT
 
-renderSource :: MediaType -> B.ByteString -> TL.Text -> Text -> Widget
+renderSource
+    :: MediaType -> B.ByteString -> TL.Text -> Text -> WidgetFor site ()
 renderSource mt contentB contentTL contentT =
     let mtName = T.pack $ show mt
 
@@ -252,3 +256,10 @@ renderPandocMarkdown input =
         = fmap (sanitizeBalance . TL.toStrict . renderHtml)
         . runPure
         . writeHtml5 writerOptions
+
+renderPrettyJSON :: ToJSON a => a -> WidgetFor site ()
+renderPrettyJSON a =
+    let prettyBL = encodePretty a
+        prettyB = BL.toStrict prettyBL
+        prettyTL = TLE.decodeUtf8 prettyBL
+    in  renderCode L.JS.lexer prettyTL prettyB
diff --git a/vervis.cabal b/vervis.cabal
index d5f685e..6f348a8 100644
--- a/vervis.cabal
+++ b/vervis.cabal
@@ -69,6 +69,7 @@ library
                        Data.List.Local
                        Data.List.NonEmpty.Local
                        Data.Maybe.Local
+                       Data.MediaType
                        Data.Paginate.Local
                        Data.Text.UTF8.Local
                        Data.Text.Lazy.UTF8.Local
@@ -106,6 +107,7 @@ library
                        Yesod.MonadSite
                        Yesod.Paginate.Local
                        Yesod.Persist.Local
+                       Yesod.RenderSource
                        Yesod.SessionEntity
 
                        Vervis.Access
@@ -162,7 +164,6 @@ library
                        Vervis.Import
                        Vervis.Import.NoFoundation
                        Vervis.KeyFile
-                       Vervis.MediaType
                        Vervis.Migration
                        Vervis.Migration.Model
                        Vervis.Migration.TH
@@ -182,7 +183,6 @@ library
                        Vervis.Query
                        Vervis.Readme
                        Vervis.RemoteActorStore
-                       Vervis.Render
                        Vervis.Role
                        Vervis.Secure
                        Vervis.Settings