compdoc (empty) → 0.1.0.0

raw patch · 5 files changed

+161/−0 lines, 5 filesdep +aesondep +basedep +composite-aeson

Dependencies added: aeson, base, composite-aeson, composite-aeson-throw, composite-base, pandoc, pandoc-throw, path, rio, vinyl

Files

• ChangeLog.md +5/−0
• LICENSE +19/−0
• README.md +7/−0
• compdoc.cabal +40/−0
• src/Text/Compdoc.hs +90/−0

@@ -0,0 +1,5 @@+# Changelog for compdoc++# v0.1.0.0++* Initial data declaration and parsing functions.

@@ -0,0 +1,19 @@+Copyright (c) 2020 Daniel Firth++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,7 @@+# Compdoc - Composite Pandoc Format++Compdoc is an alternative format for reading pandoc markdown data using [composite](https://hackage.haskell.org/package/composite-base) and [composite-aeson](https://hackage.haskell.org/package/composite-aeson).++Compdoc will read a pandoc markdown file according to the `JsonFormat` that you+supply to parse the metadata, and place the main body in an `FContents` fields+that can be accessed with the lens `view fContent`.

@@ -0,0 +1,40 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.2.+--+-- see: https://github.com/sol/hpack++name:           compdoc+version:        0.1.0.0+synopsis:       Parse a Pandoc to a composite value.+description:    Provides a functionality for transforming a Pandoc into a vinyl/composite record.+category:       Text+author:         Daniel Firth+maintainer:     dan.firth@homotopic.tech+copyright:      2020 Daniel Firth+license:        MIT+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    README.md+    ChangeLog.md++library+  exposed-modules:+      Text.Compdoc+  other-modules:+      Paths_compdoc+  hs-source-dirs:+      src+  build-depends:+      aeson+    , base >=4.7 && <5+    , composite-aeson+    , composite-aeson-throw+    , composite-base+    , pandoc+    , pandoc-throw+    , path+    , rio+    , vinyl+  default-language: Haskell2010

@@ -0,0 +1,90 @@+{- |+   Module     : Text.Compdoc+   License    : MIT+   Stability  : experimental++Provides functionality for transforming a `Pandoc` into a composite record.+-}+{-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE TypeOperators     #-}+module Text.Compdoc (+  FContent+, fContent+, Compdoc+, readMarkdown'+, readMarkdownFile+, runPandocPureDefault+, pandocToCompdoc+, contentBlock+, writeBlocksDefault+, flattenMeta+) where++import           Composite.Aeson+import           Composite.Aeson.Throw+import           Composite.Record+import           Composite.TH+import           Data.Aeson+import           Data.Vinyl ((<+>))+import           Data.Vinyl.TypeLevel+import           Path+import           RIO+import           Text.Pandoc+import           Text.Pandoc.Readers+import           Text.Pandoc.Throw++withLensesAndProxies [d|+  type FContent = "content" :-> Text+  |]++-- | A Compdoc is a Record with at least an FContent field.+type Compdoc a = a ++ (FContent : '[])++-- | Write a list of `Block`s to `Text` using `WriterOptions` defaulting to the empty string+-- in the case of error.+writeBlocksDefault :: WriterOptions -> [Block] -> Text+writeBlocksDefault wopts x = runPandocPureDefault "" (writeHtml5String wopts $ Pandoc mempty x)++-- | Run a `PandocPure` operation with a default value in the event of failure.+runPandocPureDefault :: a -> PandocPure a -> a+runPandocPureDefault x = either (const x) id . runPure++-- | Read a markdown file from disk, supplying a `JsonFormat` for the metadata.+readMarkdownFile :: (MonadIO m, MonadThrow m, Show e, Typeable e)+                 => ReaderOptions+                 -> WriterOptions+                 -> JsonFormat e (Record a)+                 -> Path b File+                 -> m (Record (Compdoc a))+readMarkdownFile ropts wopts f srcPath =+  readFileUtf8 (toFilePath srcPath) >>= readMarkdown' ropts wopts f++-- | Read some `Pandoc` markdown as `Text` as a `Record (Compdoc a)` supplying a `JsonFormat` for the metadata.+readMarkdown' :: (Show e, Typeable e, MonadThrow m) => ReaderOptions -> WriterOptions -> JsonFormat e (Record a) -> Text -> m (Record (Compdoc a))+readMarkdown' ropts wopts f x = runPandocPureThrow (Text.Pandoc.Readers.readMarkdown ropts x) >>= pandocToCompdoc writeHtml5String wopts f++-- | Transform a `Pandoc` to a `Compdoc` supplying a `JsonFormat for the metadata.+pandocToCompdoc :: (Typeable e, Show e, MonadThrow m) => (WriterOptions -> Pandoc -> PandocPure Text) -> WriterOptions -> JsonFormat e (Record a) -> Pandoc -> m (Record (Compdoc a))+pandocToCompdoc writer wopts f (Pandoc meta xs) = do+  k <- flattenMeta (writer wopts) meta >>= parseValue' f+  return $ k <+> contentBlock wopts xs++-- | Create the tail of a `Compdoc` which is just an `FContent` field.+contentBlock :: WriterOptions -> [Block] -> Record (FContent : '[])+contentBlock wopts x = writeBlocksDefault wopts x :*: RNil++-- | Flatten pandoc metadata to an aeson value.+flattenMeta :: MonadThrow m => (Pandoc -> PandocPure Text) -> Meta -> m Value+flattenMeta writer (Meta meta) = toJSON <$> traverse go meta+ where+  go :: MonadThrow m => MetaValue -> m Value+  go (MetaMap     m) = toJSON <$> traverse go m+  go (MetaList    m) = toJSONList <$> traverse go m+  go (MetaBool    m) = pure $ toJSON m+  go (MetaString  m) = pure $ toJSON m+  go (MetaInlines m) = toJSON <$> (runPandocPureThrow . writer . Pandoc mempty . (:[]) . Plain $ m)+  go (MetaBlocks  m) = toJSON <$> (runPandocPureThrow . writer . Pandoc mempty $ m)