markdown-unlit 0.1.0 → 0.2.0

raw patch · 2 files changed

+30/−17 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• markdown-unlit.cabal +1/−1
• src/Text/Markdown/Unlit.hs +29/−16

@@ -1,5 +1,5 @@ name:             markdown-unlit-version:          0.1.0+version:          0.2.0 synopsis:         Literate Haskell support for GitHub's Markdown flavor category:         Development license:          MIT

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP, OverloadedStrings #-} module Text.Markdown.Unlit (   run , unlit@@ -34,23 +34,27 @@   -- #line 1 "label"   --   case break (== "-h") args of-    (xs, ["-h", _, infile, outfile]) ->-      fmap (unlit $ mkSelector xs) (readFile infile) >>= writeFile outfile+    (xs, ["-h", fileName, infile, outfile]) ->+      fmap (unlit fileName $ 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+      mkSelector = fromMaybe ("haskell" :&: Not "ignore") . parseSelector . unwords -unlit :: Selector -> String -> String-unlit selector = unlines . concatMap codeBlockContent . filter (toP selector . codeBlockClasses) . parse+unlit :: FilePath -> Selector -> String -> String+unlit fileName selector = unlines . concatMap formatCB . filter (toP selector . codeBlockClasses) . parse   where+    formatCB :: CodeBlock -> [String]+    formatCB cb = ("#line " ++ show (codeBlockStartLine cb) ++ " " ++ show fileName) : codeBlockContent cb+     toP :: Selector -> [String] -> Bool     toP = go       where         go s = case s of           Class c -> elem c+          Not p   -> not . go p           a :&: b -> (&&) <$> go a <*> go b           a :|: b -> (||) <$> go a <*> go b @@ -59,6 +63,7 @@  data Selector   = Class String+  | Not Selector   | Selector :&: Selector   | Selector :|: Selector   deriving (Eq, Show)@@ -68,8 +73,12 @@   [] -> Nothing   xs -> (Just . foldr1 (:|:) . map parseAnds) xs   where-    parseAnds = foldr1 (:&:) . map Class . split (== '+')+    parseAnds = foldr1 (:&:) . map parseClass . split (== '+') +    parseClass c = case c of+      '!':xs -> Not (Class xs)+      _      -> Class c+     -- a copy from https://github.com/sol/string     split :: (Char -> Bool) -> String -> [String]     split p = go@@ -82,30 +91,34 @@   fromString = Class  data CodeBlock = CodeBlock {-  codeBlockClasses :: [String]-, codeBlockContent :: [String]+  codeBlockClasses   :: [String]+, codeBlockContent   :: [String]+, codeBlockStartLine :: Int } deriving (Eq, Show) +type Line = (Int, String)+ parse :: String -> [CodeBlock]-parse = go . lines+parse = go . zip [2..] . lines   where-    go :: [String] -> [CodeBlock]+    go :: [Line] -> [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)+    takeCB :: Line -> [Line] -> (CodeBlock, [Line])+    takeCB (n, fence) xs = case break isFence xs of+      (cb, rest) -> (CodeBlock (parseClasses fence) (map snd cb) n, drop 1 rest) +    isFence :: Line -> Bool+    isFence = isPrefixOf "~~~" . snd+ 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