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