snipcheck 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+56/−10 lines, 2 filesdep +containersdep ~basePVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: containers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• snipcheck.cabal +3/−2
• src/Snipcheck.hs +53/−8

@@ -1,5 +1,5 @@ name: snipcheck-version: 0.1.0.0+version: 0.1.0.1 cabal-version: >=1.10 build-type: Simple license: MIT@@ -21,7 +21,8 @@     build-depends:         base >=4.7 && <5,         pandoc >=1.19.2.1 && <1.20,-        process >=1.4.3.0 && <1.5+        process >=1.4.3.0 && <1.5,+        containers >=0.5.7.1 && <0.6     default-language: Haskell2010     hs-source-dirs: src     ghc-options: -Wall

@@ -1,9 +1,11 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE ViewPatterns #-}  module Snipcheck where  import Control.Monad import Data.Maybe+import qualified Data.Map as Map import Data.Monoid import System.Process(readCreateProcess, shell) import Text.Pandoc (Block(..))@@ -17,14 +19,14 @@ sloppyString str = Must str  checkSloppy :: Eq a => [a] -> [Sloppy a] -> Bool-checkSloppy (a:as) ((Must a'):as')+checkSloppy (a:as) (Must a':as')   | a == a' = checkSloppy as as'   | otherwise = False-checkSloppy (a:as) as'@(Skip:(Must a'):as'')+checkSloppy (a:as) as'@(Skip:Must a':as'')   | a == a' = checkSloppy as as''   | otherwise = checkSloppy as as' checkSloppy as (Skip:Skip:as') = checkSloppy as (Skip:as')-checkSloppy [] ((Must _):_) = False+checkSloppy [] (Must{}:_) = False checkSloppy [] (Skip:as') = checkSloppy [] as' checkSloppy [] [] = True checkSloppy (_:_) [] = False@@ -32,10 +34,53 @@  checkMarkdownFile :: FilePath -> IO () checkMarkdownFile fp = do-  content <- readFile fp-  let (Right (Pandoc.Pandoc _meta blocks)) = Pandoc.readMarkdown Pandoc.def content-  forM_ blocks check+    content <- readFile fp+    let Right (Pandoc.Pandoc meta blocks) = Pandoc.readMarkdown Pandoc.def content+        sections = findSections meta+        blocks' =+          if null sections+          then blocks+          else filterBlocksBySectionName sections blocks+    forM_ blocks' check +data AcceptSection+  = GoodSection+  | BadSection+  | Dunno++filterBlocksBySectionName :: [String] -> [Pandoc.Block] -> [Pandoc.Block]+filterBlocksBySectionName secs = skipThese+  where+    skipThese, keepThese :: [Pandoc.Block] -> [Pandoc.Block]+    skipThese (b:bs) =+      case acceptSection b of+        GoodSection -> keepThese bs+        _ -> skipThese bs+    skipThese [] = []+    keepThese (b:bs) = b : case acceptSection b of+      BadSection -> skipThese bs+      _ -> keepThese bs+    keepThese [] = []+    acceptSection :: Pandoc.Block -> AcceptSection+    acceptSection (Pandoc.Header _ (hName,_,_) _)+      | hName `elem` secs = GoodSection+      | otherwise = BadSection+    acceptSection _ = Dunno++findSections :: Pandoc.Meta -> [String]+findSections (Pandoc.unMeta -> meta) =+  case Map.lookup "sc_check-sections" meta of+    Just (Pandoc.MetaList ss) -> join $ unMetaString <$> ss+    _ -> []+  where+    unMetaString :: Pandoc.MetaValue -> [String]+    unMetaString (Pandoc.MetaString s) =[s]+    unMetaString (Pandoc.MetaInlines is) = mapMaybe unMetaStr is+    unMetaString _ = []+    unMetaStr :: Pandoc.Inline -> Maybe String+    unMetaStr (Pandoc.Str s) = Just s+    unMetaStr _ = Nothing+ check :: Pandoc.Block -> IO () check (CodeBlock (typ, classes, kvs) content)   | "shell" `elem` classes = do@@ -55,8 +100,8 @@   where     go :: [String] -> Either String [(String, [String])]     go (l:ls) | Just cmd <- toCommand l =-      let (output, rest) = span (not . isCommand) ls-      in ((cmd,output):) <$> (go rest)+      let (output, rest) = break isCommand ls+      in ((cmd,output):) <$> go rest               | otherwise = Left $ "Expected a command, got " <> l     go [] = Right []     toCommand :: String -> Maybe String