inliterate (empty) → 0.1.0

raw patch · 11 files changed

+514/−0 lines, 11 filesdep +basedep +blaze-htmldep +cheapskatesetup-changed

Dependencies added: base, blaze-html, cheapskate, containers, haskell-src-exts, inliterate, lucid, lucid-extras, plotlyhs, text, time

Files

• InlitPreProc.hs +13/−0
• LICENSE +21/−0
• README.md +86/−0
• Setup.hs +2/−0
• TestInliterate.hs +13/−0
• TestInliteratePreProc.hs +51/−0
• changelog.md +0/−0
• inliterate.cabal +67/−0
• lib/Inliterate.hs +126/−0
• lib/Inliterate/Import.hs +91/−0
• lib/Inliterate/Inspect.hs +44/−0

@@ -0,0 +1,13 @@+module Main where++import Inliterate+import Inliterate.Inspect+import System.Environment+import qualified Data.Text as T+import qualified Data.Text.IO as T+++main = do+  _:inFile:outFile:_ <- getArgs+  d <- readDoc inFile+  T.writeFile outFile $ genHaskell d

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2017 Tom Nielsen++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,86 @@+inliterate: Dynamic reporting for Haskell+=======++The aim of inliterate is generate dynamic markdown reports from literate Haskell code in which+code blocks can be evaluated to present the results of analyses in textual or graphical form.++inliterate is a GHC preprocessor which transforms a markdown document into a Haskell program, +which, when run, prints to stdout the input document in HTML format. Certain code blocks with special+annotations can be treated in particular ways: as Haskell code that must be included in the +generating program (at the top level or in a do block) and as code that must be evaluated with the results+inserted into the HTML document.++For an example document, see https://github.com/diffusionkinetics/open/blob/master/plotlyhs/gendoc/GenDocInlit.hs which +ccompiles into https://glutamate.github.io/plotlyhs/.++## The inliterate document++The inliterate ddocument should contain the following pragma on the first line or after the LANGUAGE pragmas:++```+{-# OPTIONS_GHC -F -pgmF inlitpp #-}+```++this tells GHC to invoke the preprocessor.++### Code blocks++inliterate gives special meaning to the following code block language annotations (see the plotlyhs documentation +generator to see how these are invoked)++#### `html_header`++this HTML should go in the header. Use this to load JavaScript or CSS, for instance for graphing libraries.++#### `haskell top`++Haskell code that is added to the top level++#### `haskell do`++Haskell code that is added to the main do block. use this for loading data or otherwise performing input and output.++#### `haskell eval`++Haskell code that is evaluated. The resultant type must be an instance of the `AskInliterate` class ddefined in +Inliterate.Import. ++#### `hide`++add this to `top` or `do` code to prevent it from being printed in the output document (but it is still run)++## How to run++### As an excutable++if you only have a few documents, you can put them in your cabal file as an executable, with `inliterate` as a build dependency.++here's the example from the plotlyhs [documentation generator](https://github.com/diffusionkinetics/open/blob/bf3e3211f936d1c66ee5f4828a6e26d4a2d5df76/plotlyhs/gendoc/plotly-gendoc.cabal#L15-L26):++```+executable plotly-gendoc+  main-is: GenDocInlit.hs+  build-depends:       base >=4.6 && <5+                     , plotlyhs+                     , lucid+                     , aeson+                     , text+                     , microlens+                     , plotlyhs+                     , inliterate+                     , datasets+                     , neat-interpolation+```++### Using stack runghc++if you have a larger number, or dynamically changing, set of documents, you can run them individually using stack runghc. `inliterate`+should be listed in your cabal file as a build dependency to make sure the package is visible.++```+stack runghc InliterateFile.hs+```+if you want only the body HTML and not the headers, you can pass the argument `--no-inlit-wrap` to the executable+```+stack runghc InliterateFile.hs -- --no-inlit-wrap+```

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,13 @@+module Main where++import Inliterate+import Inliterate.Inspect+import System.Environment+import qualified Data.Text.IO as T++main = do+  putStr "\n"+  dumpDoc "TestInliteratePreProc.hs"+  d <- readDoc "TestInliteratePreProc.hs"++  T.putStrLn $ genHaskell d

@@ -0,0 +1,51 @@+{-# OPTIONS_GHC -F -pgmF inlitpp #-}++# Test document++Hello from my test document!++```haskell hide top+import Data.Time+```++```haskell do++now <- getCurrentTime++```++```haskell do++let later :: UTCTime+    later = addUTCTime 100 now++```++```haskell top++f :: Int -> Int+f x = x - 7++```++```haskell eval++f (2+2)++```++```haskell eval++[100000::Int .. ]++```++and lets have another question++```haskell eval++(now, later)++```++Goodbye!

@@ -0,0 +1,67 @@+Name:                inliterate+Version:             0.1.0+Synopsis:            Interactive literate programming+Description:+        Evaluate markdown code blocks to show the results of running the code.+++License:             MIT+License-file:        LICENSE+Author:              Tom Nielsen+Maintainer:          tomn@diffusionkinetics.com+build-type:          Simple+Cabal-Version: 	     >= 1.8+homepage:            https://github.com/diffusionkinetics/open/inliterate+bug-reports:         https://github.com/diffusionkinetics/open/issues+category:            Statistics+Tested-With:         GHC == 7.8.4, GHC == 7.10.2, GHC == 7.10.3, GHC == 8.0.1+++extra-source-files:+                   changelog.md+                   README.md+++Library+   ghc-options:       -Wall -fno-warn-type-defaults+   hs-source-dirs:    lib++   Exposed-modules:+                   Inliterate+                 , Inliterate.Import+                 , Inliterate.Inspect++   Build-depends:+                 base                    >= 4.6 && <5+               , text+               , containers+               , cheapskate+               , blaze-html+               , time+               , plotlyhs+               , lucid+               , lucid-extras+               , haskell-src-exts+++Executable inlitpp+  main-is: InlitPreProc.hs+  build-depends:       base >=4.6 && <5+                     , inliterate+                     , text++Test-suite test-inliterate+  type:       exitcode-stdio-1.0+  main-is: TestInliterate.hs+  build-depends:       base >=4.6 && <5+                     , inliterate+                     , text++Test-suite test-inliterate-pp+  type:       exitcode-stdio-1.0+  buildable: False+  main-is: TestInliteratePreProc.hs+  build-depends:       base >=4.6 && <5+                     , inliterate+                     , text+                     , time

@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings, StandaloneDeriving, CPP #-}++module Inliterate where++import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.IO as TL+import Data.Text (Text)+import Data.List (isPrefixOf)+import qualified Data.Text.IO as T+import Cheapskate+import Cheapskate.Html+import Text.Read (readMaybe)+import Data.Foldable (toList)+import Data.Set (Set)+import qualified Data.Set as Set+import qualified Data.Sequence as Seq+import Text.Blaze.Html.Renderer.Text (renderHtml)+import Lucid+import Data.Monoid ((<>))+#if MIN_VERSION_haskell_src_exts(1,18,0)+import Language.Haskell.Exts hiding (Do)+#else+import Language.Haskell.Exts.Annotated hiding (Do)+#endif+import Inliterate.Inspect+import Inliterate.Import++dumpDoc :: FilePath -> IO ()+dumpDoc fp = do+  t <- T.readFile fp+  let md = markdown def t+  print md+  mapM_ print $ codeBlocks md+++parseCodeInfo :: Text -> Set CodeType+parseCodeInfo = Set.fromList . map parse1 . T.words where+  parse1 t = case readMaybe $ T.unpack $ T.toTitle t of+               Just ct -> ct+               Nothing -> error $ "unknown code type: "++T.unpack t++genHaskell :: Doc -> Text+genHaskell doc =+  let cbs = codeBlocks doc+      toplns = map snd $ filter ((Top `Set.member`) . fst) cbs+      mparsedTop = parseFileContents $ T.unpack $ T.unlines toplns+      newTop = case mparsedTop of+                 ParseFailed l s -> error $ "parse failure: "++s++" at "++show l+                 ParseOk m -> T.pack $ prettyPrint $ addTheImport m+      inDoBody (cb, _) = Do `Set.member` cb+      printDoBody (_,t) = T.lines $ chomp t+--      asks = map snd $ filter ((Eval `Set.member`) . fst) cbs+--      printAsk t = ["ask $ " `T.append` chomp t]+      doBody = concatMap printDoBody (filter inDoBody cbs) +++               concatMap printBlock (getBlocks doc) +++               ["return ()"]+      hdr = unlines $ map (T.unpack . codeBlockBody) $ filter isHtmlHeader $ getBlocks doc++  in T.unlines $ [newTop, "main = Inliterate.Import.wrapMain "<>T.pack (show hdr)<>" $ do"] ++ map ("  " `T.append`) doBody++addTheImport :: Module SrcSpanInfo -> Module SrcSpanInfo+addTheImport (Module l v1 v2 v6 decls) = Module l v1 v2 (m:v6) decls+  where m = ImportDecl {importAnn = l,+                        importModule = ModuleName l "Inliterate.Import",+                        importQualified = True,+                        importSrc = False,+                        importSafe = False,+                        importPkg = Nothing,+                        importAs = Just (ModuleName l "Inliterate.Import"),+                        importSpecs = Nothing}++printBlock :: Block -> [Text]+printBlock blk@(CodeBlock (CodeAttr "haskell" ci) t)+     | Eval `Set.member` ct = printAsk ct t+     | Hide `Set.member` ct = []+     | otherwise = printAnyBlock blk+  where ct = parseCodeInfo ci+printBlock blk = if isHtmlHeader blk then [] else printAnyBlock blk++isHtmlHeader (CodeBlock (CodeAttr "html_header" ci) t) = True+isHtmlHeader _ = False++codeBlockBody (CodeBlock (CodeAttr "html_header" ci) t) = t++printAsk :: Set CodeType -> Text -> [Text]+printAsk cts t+  = let showCts = map (T.pack . ("Inliterate.Import."++) . show) (Set.toList cts)+    in [T.concat ["Inliterate.Import.askInliterate ", escape $ chomp t, " ",+               "[",T.intercalate "," showCts, "]"  , " (", chomp t, ")"]]++printAnyBlock :: Block -> [Text]+printAnyBlock blk =+  map (("putStrLn " `T.append`) . escape)+  $ T.lines+  $ TL.toStrict+  $ renderHtml+  $ renderBlocks def (Seq.singleton blk)++escape :: Text -> Text+escape = T.pack . show . T.unpack++chomp :: Text -> Text+chomp = T.dropWhile (=='\n') . T.strip . T.dropWhileEnd (=='\n')++getBlocks :: Doc -> [Block]+getBlocks (Doc _ sblocks) = removeOptionsGhc $ toList sblocks++codeBlocks :: Doc -> [(Set CodeType, Text)]+codeBlocks d =+  [(parseCodeInfo ci, body)+      | CodeBlock (CodeAttr "haskell" ci) body+          <- getBlocks d]++removeOptionsGhc :: [Block] -> [Block]+removeOptionsGhc allBlks@(Para inls:blks)+    | [Str "{",Str "-",Str "#",Space,Str "OPTIONS",Str "_",Str "GHC"] `isPrefixOf` toList inls+         = removeOptionsGhc blks+    | [Str "{",Str "-",Str "#",Space,Str "LANGUAGE"] `isPrefixOf` toList inls+         = removeOptionsGhc blks+    | otherwise = allBlks+removeOptionsGhc blks = blks++deriving instance Eq Inline++  -- get extra headers

@@ -0,0 +1,91 @@+{-# LANGUAGE OverloadedStrings, DefaultSignatures, TypeSynonymInstances, FlexibleInstances #-}++module Inliterate.Import where++import Data.Time+import qualified Data.Text as T+import qualified Data.Text.Lazy.IO as TL+import Lucid+import Lucid.Bootstrap3+import Lucid.PreEscaped+import Control.Monad (unless)+import System.Environment+import Data.List (intercalate)++import Graphics.Plotly+import Graphics.Plotly.Lucid ()++data CodeType = Top | Eval | Do | Hide | Fake | Twocol | Noq deriving (Show, Eq, Read, Ord)++class AskInliterate a where+  askInliterate :: String -> [CodeType] -> a -> IO ()+  default askInliterate :: Show a => String -> [CodeType] -> a -> IO ()+  askInliterate = answerWith show++answerWith :: (a -> String) -> String -> [CodeType] -> a -> IO ()+answerWith f t cts x = do+  putStr "<pre class=\"haskell\"><code>"+  putStrLn $ concat [t, " => \n", f x]+  putStrLn "</code></pre>"++instance AskInliterate Int++instance AskInliterate Double+instance AskInliterate Float++instance AskInliterate UTCTime++instance AskInliterate String where+  askInliterate = answerWith id++instance AskInliterate T.Text where+  askInliterate = answerWith T.unpack++instance (Show a, Show b) => AskInliterate (a,b)++instance AskInliterate (Html ()) where+  askInliterate q cts html+     | Twocol `elem` cts = do+         putStrLn "<div class=\"row\">"+         putStrLn "<div class=\"col-md-6\">"+         putStr "<pre class=\"haskell\"><code>"+         putStrLn $ q+         putStrLn "</code></pre>"+         putStrLn "</div>"+         putStrLn "<div class=\"col-md-6\">"+         TL.putStrLn $ renderText html+         putStrLn "</div>"+         putStrLn "</div>"+     | otherwise = TL.putStrLn $ renderText html+++instance AskInliterate Plotly where+  askInliterate q cts plt = askInliterate q cts $ (toHtml plt :: Html ())++instance (Show a, AskInliterate a) => AskInliterate [a] where+  askInliterate = answerWith lshow where+    lshow xs = let (first5, rest) = splitAt 5 xs+                   sfirst5 = map show first5+                   (first15, rest15 ) = splitAt 15 xs+                   avgLen = realToFrac (sum $ map length sfirst5) / realToFrac (length (first5))+                   withMore ws ys = if not $ null ws then ys++["..."] else ys+               in if avgLen > (8.0::Double)+                     then "[ " ++ intercalate "\n, " (withMore rest sfirst5) ++ "]"+                     else "[" ++ intercalate "," (withMore rest15 (map show first15)) ++ "]"++wrapMain :: String -> IO () -> IO ()+wrapMain hdrTxt go = do+  args <- getArgs+  unless ("--no-inlit-wrap" `elem` args) $ do+    TL.putStrLn "<!DOCTYPE HTML><html>"+    TL.putStrLn $ renderText $ head_ $ do+      meta_ [charset_ "utf-8"]+      cdnCSS+      cdnThemeCSS+      cdnJqueryJS+      cdnBootstrapJS+      preEscaped $ T.pack hdrTxt+    TL.putStrLn "<body><div class=\"container\"><div class=\"row\"><div class=\"col-sm-12\">"+  go+  unless ("--no-inlit-wrap" `elem` args) $ do+    TL.putStrLn "</div></div></div></body></html>"

@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Inliterate.Inspect where++import Cheapskate+import Cheapskate.Html+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.IO as T+import Data.Foldable (toList)+import Text.Blaze.Html.Renderer.Text (renderHtml)++++readDoc :: FilePath -> IO Doc+readDoc fp = do+  t <- T.readFile fp+  return $ markdown def t+++inspect :: FilePath -> IO (T.Text, T.Text)+inspect fp = do+  d <- readDoc fp++  return $ getTitleFirstP d++getTitleFirstP :: Doc -> (T.Text, T.Text)+getTitleFirstP (Doc _ sblocks) = go allBlocks where+  allBlocks = toList sblocks+  go (Header _ inls : rest ) = (T.concat $ map inlineToText $ toList inls, goPara rest)+  go (_ : blocks ) = go blocks+  go [] = ("No Title", goPara allBlocks)+  goPara (Para inls : rest )  = TL.toStrict $ renderHtml $ renderInlines def inls+  goPara (_:rest) = goPara rest+  goPara [] = ""++--strip formatting+inlineToText :: Inline -> T.Text+inlineToText (Str s) = s+inlineToText Space = " "+inlineToText SoftBreak = " " -- ??+inlineToText LineBreak = " "+inlineToText (Emph inls) = T.concat $ map inlineToText $ toList inls+inlineToText (Strong inls) = T.concat $ map inlineToText $ toList inls