org-mode-lucid (empty) → 1.0.0

raw patch · 5 files changed

+278/−0 lines, 5 filesdep +basedep +hashabledep +lucid

Dependencies added: base, hashable, lucid, org-mode, text

Files

• CHANGELOG.md +7/−0
• LICENSE +30/−0
• README.md +5/−0
• lib/Data/Org/Lucid.hs +203/−0
• org-mode-lucid.cabal +33/−0

@@ -0,0 +1,7 @@+# Changelog++## 1.0.0 (2020-03-05)++#### Added++- Initial version of all `Html` conversion functions.

@@ -0,0 +1,30 @@+Copyright Colin Woodbury (c) 2020++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,5 @@+# ord-mode-lucid++This is a child library of `org-mode` that allows its types to be converted into+`Html` structures from the `lucid` library. This allows one to easily parse and+embed Org content directly into a Lucid-based website.

@@ -0,0 +1,203 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module    : Data.Org.Lucid+-- Copyright : (c) Colin Woodbury, 2020+-- License   : BSD3+-- Maintainer: Colin Woodbury <colin@fosskers.ca>+--+-- This library converts `OrgFile` values into `Html` structures from the Lucid+-- library. This allows one to generate valid, standalone HTML pages from an Org+-- file, but also to inject that HTML into a preexisting Lucid `Html` structure,+-- such as a certain section of a web page.++module Data.Org.Lucid+  ( -- * HTML Conversion+    -- | Consider `defaultStyle` as the style to pass to these functions.+    html+  , body+    -- * Styling+  , OrgStyle(..)+  , defaultStyle+  , TOC(..)+  ) where++import           Control.Monad (when)+import           Data.Foldable (fold, traverse_)+import           Data.Hashable (hash)+import           Data.List (intersperse)+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NEL+import           Data.Org+import qualified Data.Text as T+import           Lucid+import           Text.Printf (printf)++--------------------------------------------------------------------------------+-- HTML Generation++-- | Rendering options.+data OrgStyle = OrgStyle+  { includeTitle    :: Bool+    -- ^ Whether to include the @#+TITLE: ...@ value as an @<h1>@ tag at the top+    -- of the document.+  , tableOfContents :: Maybe TOC+    -- ^ Optionally include a Table of Contents after the title. The displayed+    -- depth is configurable.+  , bootstrap       :: Bool+    -- ^ Whether to add Twitter Bootstrap classes to certain elements.+  }++-- | Options for rendering a Table of Contents in the document.+data TOC = TOC+  { tocTitle :: T.Text+    -- ^ The text of the TOC to be rendered in an @<h2>@ element.+  , tocDepth :: Word+    -- ^ The number of levels to give the TOC.+  }++-- | Include the title and 3-level TOC named @Table of Contents@, and don't+-- include Twitter Bootstrap classes. This mirrors the behaviour of Emacs'+-- native HTML export functionality.+defaultStyle :: OrgStyle+defaultStyle = OrgStyle True (Just $ TOC "Table of Contents" 3) False++-- | Convert a parsed `OrgFile` into a full HTML document readable in a browser.+html :: OrgStyle -> OrgFile -> Html ()+html os o@(OrgFile m _) = html_ $ do+  head_ $ title_ (maybe "" toHtml $ metaTitle m)+  body_ $ body os o++-- | Convert a parsed `OrgFile` into the body of an HTML document, so that it+-- could be injected into other Lucid `Html` structures.+--+-- Does __not__ wrap contents in a @\<body\>@ tag.+body :: OrgStyle -> OrgFile -> Html ()+body os (OrgFile m od) = do+  when (includeTitle os) $ traverse_ (h1_ [class_ "title"] . toHtml) $ metaTitle m+  traverse_ (`toc` od) $ tableOfContents os+  orgHTML os od++-- | A unique identifier that can be used as an HTML @id@ attribute.+tocLabel :: NonEmpty Words -> T.Text+tocLabel = ("org" <>) . T.pack . take 6 . printf "%x" . hash++toc :: TOC -> OrgDoc -> Html ()+toc _ (OrgDoc _ []) = pure ()+toc t od            = h2_ (toHtml $ tocTitle t) *> toc' t 1 od++toc' :: TOC -> Word -> OrgDoc -> Html ()+toc' _ _ (OrgDoc _ []) = pure ()+toc' t depth (OrgDoc _ ss)+  | depth > tocDepth t = pure ()+  | otherwise = ul_ $ traverse_ f ss+  where+    f :: Section -> Html ()+    f (Section ws od) = do+      li_ $ a_ [href_ $ "#" <> tocLabel ws] $ lineHTML ws+      toc' t (succ depth) od++orgHTML :: OrgStyle -> OrgDoc -> Html ()+orgHTML os = orgHTML' os 1++orgHTML' :: OrgStyle -> Int -> OrgDoc -> Html ()+orgHTML' os depth (OrgDoc bs ss) = do+  traverse_ (blockHTML os) bs+  traverse_ (sectionHTML os depth) ss++sectionHTML :: OrgStyle -> Int -> Section -> Html ()+sectionHTML os depth (Section ws od) = do+  heading [id_ $ tocLabel ws] $ lineHTML ws+  orgHTML' os (succ depth) od+  where+    heading :: [Attribute] -> Html () -> Html ()+    heading as h = case depth of+      1 -> h2_ as h+      2 -> h3_ as h+      3 -> h4_ as h+      4 -> h5_ as h+      5 -> h6_ as h+      _ -> h++blockHTML :: OrgStyle -> Block -> Html ()+blockHTML os b = case b of+  Quote t -> blockquote_ . p_ $ toHtml t+  Example t -> pre_ [class_ "example"] $ toHtml t+  Code l t -> div_ [class_ "org-src-container"]+    $ pre_ [classes_ $ "src" : maybe [] (\(Language l') -> ["src-" <> l']) l]+    $ toHtml t+  List is -> listItemsHTML is+  Table rw -> tableHTML os rw+  Paragraph ws -> p_ $ paragraphHTML ws++paragraphHTML :: NonEmpty Words -> Html ()+paragraphHTML (h :| t) = wordsHTML h <> para h t+  where+    para :: Words -> [Words] -> Html ()+    para _ [] = ""+    para pr (w:ws) = case pr of+      Punct '(' -> wordsHTML w <> para w ws+      _ -> case w of+        Punct '(' -> " " <> wordsHTML w <> para w ws+        Punct _   -> wordsHTML w <> para w ws+        _         -> " " <> wordsHTML w <> para w ws++-- | Render a grouping of `Words` that you expect to appear on a single line.+lineHTML :: NonEmpty Words -> Html ()+lineHTML = fold . intersperse " " . map wordsHTML . NEL.toList++listItemsHTML :: ListItems -> Html ()+listItemsHTML (ListItems is) = ul_ [class_ "org-ul"] $ traverse_ f is+  where+    f :: Item -> Html ()+    f (Item ws next) = li_ $ lineHTML ws >> maybe (pure ()) listItemsHTML next++tableHTML :: OrgStyle -> NonEmpty Row -> Html ()+tableHTML os rs = table_ tblClasses $ do+  thead_ headClasses toprow+  tbody_ $ traverse_ f rest+  where+    tblClasses+      | bootstrap os = [classes_ ["table", "table-bordered", "table-hover"]]+      | otherwise = []++    headClasses+      | bootstrap os = [class_ "thead-dark"]+      | otherwise = []++    toprow = tr_ $ maybe (pure ()) (traverse_ g) h+    (h, rest) = j $ NEL.toList rs++    -- | Restructure the input such that the first `Row` is not a `Break`.+    j :: [Row] -> (Maybe (NonEmpty Column), [Row])+    j []           = (Nothing, [])+    j (Break : r)  = j r+    j (Row cs : r) = (Just cs, r)++    -- | Potentially render a `Row`.+    f :: Row -> Html ()+    f Break    = pure ()+    f (Row cs) = tr_ $ traverse_ k cs++    -- | Render a header row.+    g :: Column -> Html ()+    g Empty       = th_ [scope_ "col"] ""+    g (Column ws) = th_ [scope_ "col"] $ lineHTML ws++    -- | Render a normal row.+    k :: Column -> Html ()+    k Empty       = td_ ""+    k (Column ws) = td_ $ lineHTML ws++wordsHTML :: Words -> Html ()+wordsHTML ws = case ws of+  Bold t          -> b_ $ toHtml t+  Italic t        -> i_ $ toHtml t+  Highlight t     -> code_ $ toHtml t+  Underline t     -> span_ [style_ "text-decoration: underline;"] $ toHtml t+  Verbatim t      -> toHtml t+  Strike t        -> span_ [style_ "text-decoration: line-through;"] $ toHtml t+  Link (URL u) mt -> a_ [href_ u] $ maybe "" toHtml mt+  Image (URL u)   -> img_ [src_ u]+  Punct c         -> toHtml $ T.singleton c+  Plain t         -> toHtml t

@@ -0,0 +1,33 @@+cabal-version:      2.2+name:               org-mode-lucid+version:            1.0.0+description:        Lucid integration for org-mode.+homepage:           https://github.com/fosskers/org-mode+author:             Colin Woodbury+maintainer:         colin@fosskers.ca+copyright:          2020 Colin Woodbury+license:            BSD-3-Clause+license-file:       LICENSE+build-type:         Simple+extra-source-files:+  README.md+  CHANGELOG.md++common commons+  default-language:   Haskell2010+  default-extensions: OverloadedStrings+  ghc-options:+    -Wall -Wpartial-fields -Wincomplete-record-updates+    -Wincomplete-uni-patterns -Widentities++  build-depends:+    , base      >=4.12 && <5+    , hashable  >=1.2  && <1.4+    , lucid     ^>=2.9+    , org-mode  ^>=1.0+    , text++library+  import:          commons+  hs-source-dirs:  lib+  exposed-modules: Data.Org.Lucid