packages feed

panhandle (empty) → 0.2.0.0

raw patch · 7 files changed

+396/−0 lines, 7 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, containers, derive, lazysmallcheck2012, pandoc, pandoc-types, panhandle, syb, tagged, tasty, tasty-quickcheck

Files

+ LICENSE view
@@ -0,0 +1,1 @@+Public Domain
+ README.md view
@@ -0,0 +1,177 @@+# PanHandle #++This software is released into the Public Domain+ -- Chris Warburton <chriswarbo@gmail.com>, 2014-09-30++## Usage ##++You'll need some way to run Haskell. Check your package manager or go to+https://www.haskell.org/platform/ to get a compiler or a `runhaskell`+interpreter.++You'll also need Pandoc available as a library, which you can get from your+package manager or with `cabal install pandoc`, and will probably want the+`pandoc` command available too.++To use PanHandle, invoke it as a Pandoc "filter", like this:++`pandoc --filter ./panhandle input_file > output_file`++You can also run it standalone, but note that its stdio should be in Pandoc JSON+format, which you can convert to/from using `pandoc -t json`/`pandoc -f json`.++To reduce the chance for error, ensure the version of Pandoc you're using to+generate/consume the JSON is the same as the version PanHandle's built with.++## Intro ##++PanHandle is a simple Haskell script using PanDoc. It allows code blocks and+lines in PanDoc-compatible documents, eg. Markdown, to be "unwrapped" and become+part of the overall document.++Any code blocks or lines with an "unwrap" class will have their contents parsed+using Pandoc, then spliced into the document (inside a Div or Span). The content+must be in "pandoc-json" format, which you can get by passing the `-t json`+option to Pandoc.++For example, this Markdown list:++```+ - A Markdown+ - List+```++Converts to this JSON:++```+[{"unMeta":{}},[{"t":"BulletList","c":[[{"t":"Plain","c":[{"t":"Str","c":"A"},{"t":"Space","c":[]},{"t":"Str","c":"Markdown"}]}],[{"t":"Plain","c":[{"t":"Str","c":"List"}]}]]}]]+```++Which we can splice into a document:++````+Mumble mumble++```{.unwrap}+[{"unMeta":{}},[{"t":"BulletList","c":[[{"t":"Plain","c":[{"t":"Str","c":"A"},{"t":"Space","c":[]},{"t":"Str","c":"Markdown"}]}],[{"t":"Plain","c":[{"t":"Str","c":"List"}]}]]}]]+```++Groan groan+````++To give:++````+Mumble mumble++ - A Markdown+ - List++Groan groan+````++## Usage Notes ##++### Wrappers ###++Code blocks will become Pandoc-native Div blocks, code lines will become+Pandoc-native Span elements. These may affect rendering in some formats, eg.+LaTeX, and may also affect post-processors, eg. other Pandoc scripts and CSS.++### Attributes ###++All of the code block's attributes except for the "unwrap" class will be applied+to the resulting Div or Span:++````+```{#foo .bar .upper .unwrap baz="quux" something="nice"}+[{"unMeta":{}},[{"t":"Para","c":[{"t":"Str","c":"Some"},{"t":"Space","c":[]},{"t":"Emph","c":[{"t":"Str","c":"emphasised"}]},{"t":"Space","c":[]},{"t":"Str","c":"text"}]}]]+```+````++Will become:++```+<div id="foo" class="bar upper" baz="quux" something="nice">+Some *emphasised* text+</div>+```++### Replacement Order ###++PanHandle operates top-down, so blocks can be nested. For example:++    Level 1A++    `````{.unwrap}+    Level 2A++    ```{.unwrap}+    Level 3A+    ```++    ```+    Level 3B+    ```++    Level 2B+    `````++    Level 1B++Will become:++    Level 1A++    Level 2A++    Level 3A++    ```+    Level 3B+    ```++    Level 2B++    Level 1B++All code blocks are unwrapped first, then all inline code.++### Inline Snippets ###++Here's an example of PanHandle working on inline code snippets:++    I hope the following is `[{"unMeta":{}},[{"t":"Para","c":[{"t":"Emph","c":[{"t":"Str","c":"emphasised"}]}]}]]`{.unwrap}.++Will become:++    I hope the following is *emphasised*.++### No Straddling ###++PanHandle operates by splicing syntax trees together, *not* via text+replacement.++One consequence is that formatting cannot 'straddle two levels' of a document.+As an example, if we put asterisks inside and outside a code snippet (the JSON+corresponds to `be* emphasised`):++    This will *not `[{"unMeta":{}},[{"t":"Para","c":[{"t":"Str","c":"be*"},{"t":"Space","c":[]},{"t":"Str","c":"emphasised"}]}]]`{.unwrap}.++They will remain as asterisks:++    This will \*not be\* emphasised.++They *will not* join together for emphasis, like this:++    This will *not be* emphasised.++### PanPipe ###++PanHandle may be useful to you as a standalone script, but it was originally+created to augment PanPipe. PanPipe can send the contents of code blocks to the+stdin of a UNIX shell command, and dump the stdout back into the block.++PanHandle allows these results to escape their blocks and become part of the+document. This makes it easy to write documents containing code to+programmatically fetch/generate parts of themselves.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ panhandle.cabal view
@@ -0,0 +1,52 @@+name:                panhandle+version:             0.2.0.0+synopsis:            Pandoc filter to unwrap nested blocks+description:         Pandoc filter to splice together nested documents+homepage:            http://chriswarbo.net/projects/activecode+license:             PublicDomain+license-file:        LICENSE+author:              Chris Warburton+maintainer:          chriswarbo@gmail.com+category:            Text+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++source-repository head+  type:     git+  location: http://chriswarbo.net/git/panhandle.git++library+  hs-source-dirs:      src+  exposed-modules:     PanHandle+  default-language:    Haskell2010+  build-depends:       base   >=4.7  && <4.10+                     , pandoc >=1.17 && <1.18+                     , pandoc-types+                     , syb++executable panhandle+  main-is:             Main.hs+  build-depends:       base >=4.7 && <4.10+                     , panhandle+  hs-source-dirs:      panhandle+  default-language:    Haskell2010++test-suite tests+  default-language:    Haskell2010+  type:                exitcode-stdio-1.0+  hs-source-dirs:      tests+  main-is:             Main.hs+  build-depends:       base       >= 4.7+                     , panhandle+                     , QuickCheck+                     , tasty      >= 0.7+                     , tasty-quickcheck+                     , lazysmallcheck2012+                     , tagged+                     , containers >=0.5  && <0.6+                     , pandoc+                     , pandoc-types+                     , derive+                     , syb+                     , aeson
+ panhandle/Main.hs view
@@ -0,0 +1,4 @@+module Main where+import PanHandle++main = panhandleMain
+ src/PanHandle.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE CPP, RankNTypes #-}+module PanHandle where++import Control.Applicative+import Data.Data+import Data.Generics+import Data.Maybe+import Text.Pandoc+import Text.Pandoc.JSON+import Text.Pandoc.Walk (walk, query)++-- Generic (Inline and Block) functions++noUnwrap :: Attr -> Maybe Attr+noUnwrap (x, ys, zs) = if "unwrap" `elem` ys+                          then Just (x, filter (/= "unwrap") ys, zs)+                          else Nothing++-- Block-level functions++bAttrs :: Block -> Maybe Attr+bAttrs (CodeBlock as _) = Just as+bAttrs _                = Nothing++bNoUnwrap :: Block -> Maybe Attr+bNoUnwrap b = bAttrs b >>= noUnwrap++bCode :: Block -> Maybe String+bCode (CodeBlock _ c) = Just c+bCode _               = Nothing++blocks :: Pandoc -> [Block]+blocks (Pandoc _ bs) = bs++readJson :: ReaderOptions -> String -> Pandoc+#if MIN_VERSION_pandoc(1,14,0)+readJson ro s = case readJSON ro s of+                     Left  x -> error (show x)+                     Right x -> x+#else+readJson = readJSON+#endif++bUnwrap' :: Block -> [Block]+bUnwrap' b = case b of+  CodeBlock (i, cs, as) x | "unwrap" `elem` cs ->+    let content = bUnwrap (blocks (readJson def x))+     in case (i, filter (/= "unwrap") cs, as) of+             ("", [],  []) -> content+             (_,  cs', _)  -> [Div (i, cs', as) content]+  _                                            -> gmapM (mkM bUnwrap') b++bUnwrap :: [Block] -> [Block]+bUnwrap = concatMap bUnwrap'++-- Inline-level functions++iAttrs :: Inline -> Maybe Attr+iAttrs (Code as _) = Just as+iAttrs _           = Nothing++iNoUnwrap :: Inline -> Maybe Attr+iNoUnwrap b = iAttrs b >>= noUnwrap++iCode :: Inline -> Maybe String+iCode (Code _ c) = Just c+iCode _          = Nothing++inlines :: Pandoc -> [Inline]+inlines (Pandoc _ bs) = let f (Plain x) = x+                            f (Para  x) = x+                            f _         = []+                         in concatMap f bs++iUnwrap :: Inline -> Inline+iUnwrap i = let is      = inlines <$> (readJson def <$> iCode i)+                is'     = map iUnwrap <$> is+                wrapped = Span    <$> iNoUnwrap i <*> is'+             in fromMaybe i wrapped++transform :: Pandoc -> Pandoc+transform = topDown iUnwrap . topDown bUnwrap++panhandleMain = toJSONFilter transform
+ tests/Main.hs view
@@ -0,0 +1,76 @@+module Main where++import Generators+import Data.Aeson+import Data.Char+import Data.Maybe+import Debug.Trace+import PanHandle+import LSC+import Text.Pandoc+import Text.Pandoc.UTF8+import qualified Test.LazySmallCheck2012 as LSC+import Test.QuickCheck+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.QuickCheck++main = defaultMain $ testGroup "All tests" [+           testProperty "noUnwrap ignores no .wrap" noUnwrapIgnore+         , testProperty "noUnwrap removes .wrap"    noUnwrapRemove+         , testProperty "Block IDs remain"          bWrappedId+         , testProperty "Block classes remain"      bWrappedCls+         , testProperty "Block attributes remain"   bWrappedAttr+         , lazyProperty "No spurious divs"          bUnwrapped+         , lazyProperty "Pandoc JSON parses"        canParseJson+         , lazyProperty "Pandoc Aeson parses"       canParseAeson+         , testProperty "Can read empty doc"        canReadPandoc+         ]++noUnwrapIgnore x ys zs = let ys' = filter (/= "unwrap") ys+                          in isNothing (noUnwrap (x, ys', zs))++noUnwrapRemove x pre post zs =+  let cls                 = stripUnwrap (pre ++ post)+      Just (x', ys', zs') = noUnwrap (x, addUnwrap pre post, zs)+   in and [x == x',+           all (`elem` ys') cls,+           all (`elem` cls) ys',+           all (`elem` zs') zs,+           all (`elem` zs)  zs']++bWrappedId id pre post as b = not (null id) ==>+  case bUnwrap' (CodeBlock (id, addUnwrap pre post, as) b) of+       [Div (id', _, _) _] -> id' == id+       _                   -> False++bWrappedCls id pre post as b = any (not . null) (stripUnwrap (pre ++ post)) ==>+  let cls = stripUnwrap (pre ++ post)+   in case bUnwrap' (CodeBlock (id, addUnwrap pre post, as) b) of+           [Div (_, cls', _) _] -> all (`elem` cls) cls' && all (`elem` cls') cls+           _                    -> False++bWrappedAttr id pre post as b = any (\(x, y) -> not (null x || null y)) as ==>+  case bUnwrap' (CodeBlock (id, addUnwrap pre post, as) b) of+       [Div (_, _, as') _] -> all (`elem` as) as' && all (`elem` as') as+       _                   -> False++encodeDoc = toStringLazy . Data.Aeson.encode++canParseJson :: Pandoc -> Bool+canParseJson p = readJson def (encodeDoc p) == p++canParseAeson :: Pandoc -> Bool+canParseAeson p = Data.Aeson.decode (Data.Aeson.encode p) == Just p++canReadPandoc :: Bool+canReadPandoc = case readJson def "[{\"unMeta\":{}},[]]" of+                  Pandoc _ _ -> True++bUnwrapped :: Pandoc -> Bool+bUnwrapped d@(Pandoc _ bs) =+  bs == bUnwrap' (CodeBlock ("", ["unwrap"], []) (encodeDoc d))++-- Helpers+stripUnwrap = filter (/= "unwrap")++addUnwrap xs ys = stripUnwrap xs ++ ["unwrap"] ++ stripUnwrap ys