diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,9 @@ # Changelog +* **1.3.0.0** + - "Snippet mode" and "range mode" can no longer be used together + - Using the `numberLines` class sets the `startFrom` attribute for correct + line numbering * **1.2.0.2** - Replace bad `Setup.hs` script with default one * **1.2.0.1** diff --git a/pandoc-include-code.cabal b/pandoc-include-code.cabal --- a/pandoc-include-code.cabal +++ b/pandoc-include-code.cabal @@ -8,7 +8,7 @@ author: Oskar Wickström maintainer: Oskar Wickström homepage: https://github.com/owickstrom/pandoc-include-code -version: 1.2.0.2 +version: 1.3.0.0 cabal-version: >= 1.8 build-type: Simple category: Documentation @@ -43,9 +43,13 @@ test-suite filter-tests type: exitcode-stdio-1.0 hs-source-dirs: test + other-modules: FilterTest main-is: Driver.hs build-depends: base >= 4 && < 5 , pandoc-types >= 1.12 && <= 1.19 , pandoc-include-code , tasty , tasty-hunit + , tasty-hspec + , hspec + , hspec-expectations diff --git a/src/Text/Pandoc/Filter/IncludeCode.hs b/src/Text/Pandoc/Filter/IncludeCode.hs --- a/src/Text/Pandoc/Filter/IncludeCode.hs +++ b/src/Text/Pandoc/Filter/IncludeCode.hs @@ -7,32 +7,43 @@ {-# LANGUAGE RecordWildCards #-} module Text.Pandoc.Filter.IncludeCode - ( includeCode + ( InclusionMode(..) + , InclusionError(..) + , includeCode + , includeCode' ) where #if MIN_VERSION_base(4,8,0) +import Control.Applicative ((<|>)) #else import Control.Applicative import Data.Monoid #endif - import Control.Monad.Except import Control.Monad.Reader +import Control.Monad.State import Data.Char (isSpace) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HM import Data.List (isInfixOf) +import Data.Maybe (catMaybes) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text import Text.Pandoc.JSON import Text.Read (readMaybe) -import Text.Pandoc.Filter.Range (Range, mkRange, rangeEnd, rangeStart) +import Text.Pandoc.Filter.Range (LineNumber, Range, mkRange, rangeEnd, + rangeStart) +data InclusionMode + = SnippetMode Text + | RangeMode Range + | EntireFileMode + deriving (Show, Eq) + data InclusionSpec = InclusionSpec { include :: FilePath - , snippet :: Maybe Text - , range :: Maybe Range + , mode :: InclusionMode , dedent :: Maybe Int } @@ -42,42 +53,59 @@ deriving (Show, Eq) data InclusionError - = InvalidRange Int - Int + = InvalidRange LineNumber + LineNumber | IncompleteRange MissingRangePart + | ConflictingModes [InclusionMode] deriving (Show, Eq) +newtype InclusionState = InclusionState + { startLineNumber :: Maybe LineNumber + } + newtype Inclusion a = Inclusion - { runInclusion :: ReaderT InclusionSpec (ExceptT InclusionError IO) a + { runInclusion :: ReaderT InclusionSpec (StateT InclusionState (ExceptT InclusionError IO)) a } deriving ( Functor , Applicative , Monad , MonadIO , MonadReader InclusionSpec , MonadError InclusionError + , MonadState InclusionState ) -runInclusion' :: InclusionSpec -> Inclusion a -> IO (Either InclusionError a) -runInclusion' spec action = runExceptT (runReaderT (runInclusion action) spec) +runInclusion' :: + InclusionSpec + -> Inclusion a + -> IO (Either InclusionError (a, InclusionState)) +runInclusion' spec action = + runExceptT (runStateT (runReaderT (runInclusion action) spec) initialState) + where + initialState = InclusionState {startLineNumber = Nothing} parseInclusion :: HashMap String String -> Either InclusionError (Maybe InclusionSpec) parseInclusion attrs = case HM.lookup "include" attrs of Just include -> do - range <- getRange + rangeMode <- parseRangeMode + mode <- + case catMaybes [rangeMode, snippetMode] of + [] -> return EntireFileMode + [m] -> return m + ms -> throwError (ConflictingModes ms) return (Just InclusionSpec {..}) Nothing -> return Nothing where lookupInt name = HM.lookup name attrs >>= readMaybe - snippet = Text.pack <$> HM.lookup "snippet" attrs + snippetMode = SnippetMode . Text.pack <$> HM.lookup "snippet" attrs dedent = lookupInt "dedent" - getRange = + parseRangeMode = case (lookupInt "startLine", lookupInt "endLine") of (Just start, Just end) -> maybe (throwError (InvalidRange start end)) - (return . Just) + (return . Just . RangeMode) (mkRange start end) (Nothing, Just _) -> throwError (IncompleteRange Start) (Just _, Nothing) -> throwError (IncompleteRange End) @@ -85,34 +113,35 @@ type Lines = [Text] +setStartLineNumber :: LineNumber -> Inclusion () +setStartLineNumber n = modify (\s -> s {startLineNumber = Just n}) + readIncluded :: Inclusion Text readIncluded = liftIO . Text.readFile =<< asks include -filterLineRange :: Lines -> Inclusion Lines -filterLineRange ls = - asks range >>= \case - Just range -> - return (take (rangeEnd range - startIndex) (drop startIndex ls)) - where startIndex = pred (rangeStart range) - Nothing -> return ls - isSnippetTag :: Text -> Text -> Text -> Bool isSnippetTag tag name line = mconcat [tag, " snippet ", name] `Text.isSuffixOf` Text.strip line isSnippetStart, isSnippetEnd :: Text -> Text -> Bool isSnippetStart = isSnippetTag "start" + isSnippetEnd = isSnippetTag "end" -onlySnippet :: Lines -> Inclusion Lines -onlySnippet ls = do - s <- asks snippet - case s of - Just name -> - return $ - drop 1 $ - takeWhile (not . isSnippetEnd name) $ dropWhile (not . isSnippetStart name) ls - Nothing -> return ls +includeByMode :: Lines -> Inclusion Lines +includeByMode ls = + asks mode >>= \case + SnippetMode name -> do + let (before, start) = break (isSnippetStart name) ls + -- index +1 for line number, then +1 for snippet comment line, so +2: + startLine = length before + 2 + setStartLineNumber startLine + return (takeWhile (not . isSnippetEnd name) (drop 1 start)) + RangeMode range -> do + setStartLineNumber (rangeStart range) + return (take (rangeEnd range - startIndex) (drop startIndex ls)) + where startIndex = pred (rangeStart range) + EntireFileMode -> return ls dedentLines :: Lines -> Inclusion Lines dedentLines ls = do @@ -129,13 +158,20 @@ | otherwise -> Text.cons c cs Nothing -> "" -filterAttributes :: [(String, String)] -> [(String, String)] -filterAttributes = filter nonFilterAttribute +modifyAttributes :: + InclusionState -> [String] -> [(String, String)] -> [(String, String)] +modifyAttributes InclusionState {startLineNumber} classes = + (++) extraAttrs . filter nonFilterAttribute where nonFilterAttribute (key, _) = key `notElem` attributeNames attributeNames = ["include", "startLine", "endLine", "snippet", "dedent"] + extraAttrs = + case startLineNumber of + Just n + | "numberLines" `elem` classes -> [("startFrom", show n)] + _ -> [] -printAndFail :: InclusionError -> IO Block +printAndFail :: InclusionError -> IO a printAndFail = fail . formatError where formatError = @@ -144,6 +180,7 @@ "Invalid range: " ++ show start ++ " to " ++ show end IncompleteRange Start -> "Incomplete range: \"startLine\" is missing" IncompleteRange End -> "Incomplete range: \"endLine\" is missing" + ConflictingModes modes -> "Conflicting modes: " ++ show modes splitLines :: Text -> Inclusion Lines splitLines = return . Text.lines @@ -153,22 +190,24 @@ allSteps :: Inclusion Text allSteps = - readIncluded - >>= splitLines - >>= filterLineRange - >>= onlySnippet - >>= dedentLines - >>= joinLines + readIncluded >>= splitLines >>= includeByMode >>= dedentLines >>= joinLines --- | A Pandoc filter that includes code snippets from external files. -includeCode :: Maybe Format -> Block -> IO Block -includeCode _ cb@(CodeBlock (id', classes, attrs) _) = +includeCode' :: Block -> IO (Either InclusionError Block) +includeCode' cb@(CodeBlock (id', classes, attrs) _) = case parseInclusion (HM.fromList attrs) of Right (Just spec) -> runInclusion' spec allSteps >>= \case - Left err -> printAndFail err - Right contents -> - return (CodeBlock (id', classes, filterAttributes attrs) (Text.unpack contents)) - Right Nothing -> return cb - Left err -> printAndFail err -includeCode _ x = return x + Left err -> return (Left err) + Right (contents, state) -> + return + (Right + (CodeBlock + (id', classes, modifyAttributes state classes attrs) + (Text.unpack contents))) + Right Nothing -> return (Right cb) + Left err -> return (Left err) +includeCode' x = return (Right x) + +-- | A Pandoc filter that includes code snippets from external files. +includeCode :: Maybe Format -> Block -> IO Block +includeCode _ = includeCode' >=> either printAndFail return diff --git a/src/Text/Pandoc/Filter/Range.hs b/src/Text/Pandoc/Filter/Range.hs --- a/src/Text/Pandoc/Filter/Range.hs +++ b/src/Text/Pandoc/Filter/Range.hs @@ -1,16 +1,20 @@ -- | A range that cannot be constructed with incorrect bounds. module Text.Pandoc.Filter.Range - ( Range + ( LineNumber + , Range , rangeStart , rangeEnd , mkRange ) where -data Range = Range { rangeStart :: Int - , rangeEnd :: Int +type LineNumber = Int + +data Range = Range { rangeStart :: LineNumber + , rangeEnd :: LineNumber } + deriving (Show, Eq) -mkRange :: Int -> Int -> Maybe Range +mkRange :: LineNumber -> LineNumber -> Maybe Range mkRange s e | s > 0 && e > 0 && s <= e = Just (Range s e) | otherwise = Nothing diff --git a/test/FilterTest.hs b/test/FilterTest.hs new file mode 100644 --- /dev/null +++ b/test/FilterTest.hs @@ -0,0 +1,78 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} + +module FilterTest where + +import Test.Tasty +import Test.Tasty.HUnit + +import qualified Text.Pandoc.Filter.IncludeCode as Filter +import Text.Pandoc.JSON + +fails a = + a >>= \case + Left _ -> return () + Right x -> fail "" + +a `failsWith` b = a >>= (@?= Left b) + +a `succeedsWith` b = a >>= (@?= Right b) + +type Formatted = Bool + +includeCode :: + String + -> [String] + -> [(String, String)] + -> IO (Either Filter.InclusionError Block) +includeCode fixtureName classes attrs = + Filter.includeCode' + (CodeBlock + ( "" + , classes + , mconcat [[("include", "test/fixtures/" ++ fixtureName)], attrs]) + "") + +noRange = (Nothing, Nothing) + +codeBlock :: String -> Block +codeBlock = CodeBlock ("", [], []) + +tests = + testGroup + "Text.Pandoc.Filter.IncludeCode" + [ testCase "includes snippet" $ + includeCode "foo-snippet.txt" [] [("snippet", "foo")] `succeedsWith` + codeBlock "foo\n" + , testCase "includes snippet by exact name, not prefix" $ + includeCode "foo-snippets.txt" [] [("snippet", "foo")] `succeedsWith` + codeBlock "foo\n" + , testCase "disallows conflicting modes" $ + fails $ + includeCode + "foo-snippet.txt" + [] + [("snippet", "foo"), ("startLine", "2"), ("endLine", "3")] + , testCase "includes only lines between start and end line" $ + includeCode "some-text.txt" [] [("startLine", "2"), ("endLine", "3")] `succeedsWith` + codeBlock "world\nthis\n" + , testCase "dedents lines as much as specified" $ + includeCode "indents.txt" [] [("dedent", "1")] `succeedsWith` + codeBlock "zero\n two\none\n three\n eight\n" + , testCase + "dedents lines as much as possible without removing non-whitespace" $ + includeCode "indents.txt" [] [("dedent", "8")] `succeedsWith` + codeBlock "zero\ntwo\none\nthree\neight\n" + , testCase "sets startFrom attribute in range mode if numberLines is present" $ + includeCode + "some-text.txt" + ["numberLines"] + [("startLine", "2"), ("endLine", "3")] `succeedsWith` + CodeBlock ("", ["numberLines"], [("startFrom", "2")]) "world\nthis\n" + , testCase "sets startFrom attribute in snippet mode if numberLines is present" $ + includeCode + "foo-snippet.txt" + ["numberLines"] + [("snippet", "foo")] `succeedsWith` + CodeBlock ("", ["numberLines"], [("startFrom", "2")]) "foo\n" + ]