markdown-unlit (empty) → 0.1.0

raw patch · 6 files changed

+201/−0 lines, 6 filesdep +QuickCheckdep +basedep +directorysetup-changed

Dependencies added: QuickCheck, base, directory, hspec, markdown-unlit, silently, stringbuilder

Files

• LICENSE +19/−0
• Setup.lhs +3/−0
• driver/Main.hs +8/−0
• markdown-unlit.cabal +56/−0
• src/Text/Markdown/Unlit.hs +114/−0
• test/Spec.hs +1/−0

@@ -0,0 +1,19 @@+Copyright (c) 2012 Simon Hengel <sol@typeful.net>++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,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain

@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import           System.Environment+import           Text.Markdown.Unlit++main :: IO ()+main = getArgs >>= run

@@ -0,0 +1,56 @@+name:             markdown-unlit+version:          0.1.0+synopsis:         Literate Haskell support for GitHub's Markdown flavor+category:         Development+license:          MIT+license-file:     LICENSE+copyright:        (c) 2012 Simon Hengel+author:           Simon Hengel <sol@typeful.net>+maintainer:       Simon Hengel <sol@typeful.net>+build-type:       Simple+cabal-version:    >= 1.8+description:      Documentation is here: <https://github.com/sol/markdown-unlit#readme>++source-repository head+  type: git+  location: https://github.com/sol/markdown-unlit++library+  ghc-options:+      -Wall+  hs-source-dirs:+      src+  exposed-modules:+      Text.Markdown.Unlit+  build-depends:+      base < 5++executable markdown-unlit+  ghc-options:+      -Wall+  hs-source-dirs:+      driver+  main-is:+      Main.hs+  build-depends:+      base+    , markdown-unlit++test-suite spec+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall -Werror+  cpp-options:+      -DTEST+  hs-source-dirs:+      src, test+  main-is:+      Spec.hs+  build-depends:+      base+    , stringbuilder+    , directory+    , silently+    , hspec >= 1.3+    , QuickCheck

@@ -0,0 +1,114 @@+{-# LANGUAGE CPP #-}+module Text.Markdown.Unlit (+  run+, unlit+, Selector (..)+, parseSelector+, CodeBlock (..)+, parse+#ifdef TEST+, parseClasses+#endif+) where++import           Control.Applicative+import           Data.Maybe+import           Data.List+import           Data.Char+import           Data.String+import           System.IO+import           System.Exit+import           System.Environment++-- | Program entry point.+run :: [String] -> IO ()+run args =+  -- GHC calls unlit like so:+  --+  -- > unlit [args] -h label Foo.lhs /tmp/somefile+  --+  -- [args] are custom arguments provided with -optL+  --+  -- The label is meant to be used in line pragmas, like so:+  --+  -- #line 1 "label"+  --+  case break (== "-h") args of+    (xs, ["-h", _, infile, outfile]) ->+      fmap (unlit $ mkSelector xs) (readFile infile) >>= writeFile outfile+    _ -> do+      name <- getProgName+      hPutStrLn stderr ("usage: " ++ name ++ " [selector] -h label infile outfile")+      exitFailure+    where+      mkSelector = fromMaybe (Class "haskell") . parseSelector . unwords++unlit :: Selector -> String -> String+unlit selector = unlines . concatMap codeBlockContent . filter (toP selector . codeBlockClasses) . parse+  where+    toP :: Selector -> [String] -> Bool+    toP = go+      where+        go s = case s of+          Class c -> elem c+          a :&: b -> (&&) <$> go a <*> go b+          a :|: b -> (||) <$> go a <*> go b++infixr 3 :&:+infixr 2 :|:++data Selector+  = Class String+  | Selector :&: Selector+  | Selector :|: Selector+  deriving (Eq, Show)++parseSelector :: String -> Maybe Selector+parseSelector input = case words input of+  [] -> Nothing+  xs -> (Just . foldr1 (:|:) . map parseAnds) xs+  where+    parseAnds = foldr1 (:&:) . map Class . split (== '+')++    -- a copy from https://github.com/sol/string+    split :: (Char -> Bool) -> String -> [String]+    split p = go+      where+        go xs = case break p xs of+          (ys, [])   -> [ys]+          (ys, _:zs) -> ys : go zs++instance IsString Selector where+  fromString = Class++data CodeBlock = CodeBlock {+  codeBlockClasses :: [String]+, codeBlockContent :: [String]+} deriving (Eq, Show)++parse :: String -> [CodeBlock]+parse = go . lines+  where+    go :: [String] -> [CodeBlock]+    go xs = case break isFence xs of+      (_, [])   -> []+      (_, y:ys) -> case takeCB y ys of+        (cb, rest) -> cb : go rest++    takeCB :: String -> [String] -> (CodeBlock, [String])+    takeCB fence xs = case break isFence xs of+      (cb, rest) -> (CodeBlock (parseClasses fence) cb, drop 1 rest)++parseClasses :: String -> [String]+parseClasses xs = case dropWhile isSpace . dropWhile (== '~') $ xs of+  '{':ys -> words . replace '.' ' ' . takeWhile (/= '}') $ ys+  _      -> []++isFence :: String -> Bool+isFence = isPrefixOf "~~~"++replace :: Char -> Char -> String -> String+replace x sub = map f+  where+    f y | x == y    = sub+        | otherwise = y

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}