diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,1 @@ +Public Domain diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,177 @@ +# PanHandle # + +This software is released into the Public Domain + -- Chris Warburton , 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: + +``` +
+Some *emphasised* text +
+``` + +### 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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/panhandle.cabal b/panhandle.cabal new file mode 100644 --- /dev/null +++ b/panhandle.cabal @@ -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 diff --git a/panhandle/Main.hs b/panhandle/Main.hs new file mode 100644 --- /dev/null +++ b/panhandle/Main.hs @@ -0,0 +1,4 @@ +module Main where +import PanHandle + +main = panhandleMain diff --git a/src/PanHandle.hs b/src/PanHandle.hs new file mode 100644 --- /dev/null +++ b/src/PanHandle.hs @@ -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 diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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