diff --git a/markupParser/Text/Udoc/Document.hs b/markupParser/Text/Udoc/Document.hs index 0905f6f..4fb8eaa 100644 --- a/markupParser/Text/Udoc/Document.hs +++ b/markupParser/Text/Udoc/Document.hs @@ -17,6 +17,9 @@ Stability : experimental This module contains all the udoc-related data types. -} + +{-# LANGUAGE CPP #-} + module Text.Udoc.Document (DocumentItem(..), OListItem(..), UListItem(..), Heading(..), DocumentContainer(..), DocumentImage(..), @@ -55,7 +58,11 @@ showJSON' (Just x) = showJSON x showJSON' Nothing = JSNull {-| Lookup the JSValue of a map key that may not exist. -} +#if MIN_VERSION_base(4,13,0) +mLookup :: (MonadFail m) => String -> [(String, b)] -> m b +#else mLookup :: (Monad m) => String -> [(String, b)] -> m b +#endif mLookup a as = maybe (fail $ "No such element: " ++ a) return (lookup a as) instance JSON DocumentContainer where diff --git a/markupParser/Text/Udoc/DocumentParser.hs b/markupParser/Text/Udoc/DocumentParser.hs index 3c3d33b..b804378 100644 --- a/markupParser/Text/Udoc/DocumentParser.hs +++ b/markupParser/Text/Udoc/DocumentParser.hs @@ -19,6 +19,7 @@ This module contains the implementation of the udoc parser. -} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE CPP #-} module Text.Udoc.DocumentParser where @@ -39,7 +40,9 @@ import Text.Parsec.Indent import Text.Parsec.Pos import Control.Applicative hiding ((<|>), many, optional) import Text.Read +import Text.Printf import Data.List +import qualified Data.List.Split as S data SyntaxOption = SkipNewlinesAfterUlist | SkipNewlinesAfterImage @@ -259,7 +262,11 @@ optRename optKeyName aList = -- all required and optional arguments from a list. The obtained arguments will -- be renamed and then a function will be invoked on both resulting argument -- lists. The result of the function will be returned. -getArgumentsOrFail :: (Monad m, Eq a, Show a) => +#if MIN_VERSION_base(4,13,0) +getArgumentsOrFail :: (MonadFail m, Eq a, Show a) => +#else +getArgumentsOrFail :: (Monad m, Eq a, Show a) => +#endif [(a, b)] -- ^ A renaming pair for the mandatory args -> [(a, b)] -- ^ A renaming pair for the optional args -> [(a, c)] -- ^ An association list @@ -278,7 +285,11 @@ getArgumentsOrFail mandArgs optArgs aList f = Just m' -> return $ f m' opt {-| Lookup a required tag attribute that may not exist. -} +#if MIN_VERSION_base(4,13,0) +mLookup :: (Show a, MonadFail m, Eq a) => a -> [(a , b)] -> String -> m b +#else mLookup :: (Show a, Monad m, Eq a) => a -> [(a , b)] -> String -> m b +#endif mLookup k al error_message = maybe (fail error_message) return $ lookup k al -- | Creates an ItemMetaTag from the following data: a tag name, the list @@ -293,7 +304,11 @@ createMetaTag t mprops oprops = ItemMetaTag $ [("type", t)] ++ mprops ++ oprops -- function will lookup all mandatory and optional arguments from the argument -- list that has been supplied. If this worked out, it will return an -- ItemMetaTag. -handleMetaTag :: (Monad m, Show a, Eq a) => +#if MIN_VERSION_base(4,13,0) +handleMetaTag :: (MonadFail m, Show a, Eq a) => +#else +handleMetaTag :: (Monad m, Show a, Eq a) => +#endif String -- ^ The name of the tag type -> [(a, String)] -- ^ Mandatory tag arguments -> [(a, String)] -- ^ Optional tag arguments @@ -387,6 +402,61 @@ removeTrailingNewline items = where nl (ItemWord w) = [ItemWord $ dropWhileEnd isSpace w] nl x = [x] +-- | Split text into lines. +-- Assume only ItemWord since that's how source code works. +splitLines :: DocumentItem -> [String] +splitLines (ItemWord source) = map (++"\n") $ S.splitOn "\n" source + +-- | Prefix lines with a linenumber, starting at firstnumber and aligned s.t., +-- they align with the maximum line number used. +numberLines :: [String] -> Integer -> Integer -> [String] +numberLines [] _ _ = [] +numberLines (l:ls) firstnumber maxln = (ln++sep++l):(numberLines ls (firstnumber+1) maxln) + where ln = printf fmtstr $ firstnumber + sep = " | " + fmtstr = "%"++(show $ digits)++"d" + digits :: Integral i => i + digits = ceiling $ logBase 10 (fromInteger maxln) + +-- | Create a list which, for each entry in the range, contains the sublist +-- source[l:l+n] containing the n lines starting at line l. +-- Lines may be duplicated. +getSourceRanges :: [a] -> [(Integer,Integer)] -> [a] +getSourceRanges [] _ = [] +getSourceRanges _ [] = [] +getSourceRanges source (r:rs) = (removeOutsideRange source r)++(getSourceRanges source rs) + where removeOutsideRange source (o,n) = take (fromInteger n) (drop (fromInteger o-1) source) + +-- Encodes a range as a tuple of "start" and "length" +-- length > 0 +newtype Range = Range (Integer,Integer) +instance Show Range where + show (Range (a,b)) = (show a) ++ "-" ++ (show $ a+b-1) +-- shamelessly adapted from +-- https://coderedirect.com/questions/332937/making-a-read-instance-in-haskell +instance Read Range where + readsPrec _ input = + let (starts,rest) = span isDigit input + start = read starts :: Integer + (d:rest2) = rest + (ends,rest3) = span isDigit rest2 + end = read ends :: Integer + in + if d == '-' && end >= start then + [(Range (start,end-start+1), rest3)] + else [] + +-- | Parse a range of the format "12-15,9-11,15-23" and output a list of +-- starting lines as well as # of lines to include in the range. In this case +-- [(12,4), (9,3), (15,9)]. +textRange :: String -> [(Integer, Integer)] +textRange s = map range2Tuple $ (read s' :: [Range]) + where s' = "[" ++ s ++ "]" + +range2Tuple :: Range -> (Integer,Integer) +range2Tuple (Range (a,b)) = (a,b) + + -- | Handle an extended command. This is called once a command -- has been found. It's responsible for returning the appropriate -- data structure for the parse tree. @@ -459,11 +529,22 @@ handleExtendedCommand name args handleSpecialCommand = "_q" -> handleInlineQuote handleSpecialCommand "source" -> do let language = fromMaybe "" $ lookup "language" args + let firstnumber = fromMaybe 1 $ (\fn -> read fn :: Integer) <$> lookup "firstnumber" args + let numbers = fromMaybe False $ (\n -> read n :: Bool) <$> lookup "numbers" args skipEmptyLines source <- manyTill (verbatimContent "[/source]") (extendedCommandName "/source") eatSpaces <- isOptionSet SkipNewlinesAfterSourceOrQuoteBlock when eatSpaces skipEmptyLines - return $ ItemDocumentContainer $ DocumentMetaContainer ([("type", "source"), ("language", language)]) (removeTrailingNewline source) + -- We assume that there's only a single ItemWord String collected. + let lines = splitLines $ head $ removeTrailingNewline source + let offsetRange = fromMaybe [(firstnumber, (toInteger $ length lines))] $ textRange <$> lookup "range" args + -- Offset our range by the first number + let range = map (\(a,b) -> (a-firstnumber+1,b)) offsetRange + let maxln = maximum $ map (\(a,b) -> a+b) offsetRange + let numbered = if numbers then numberLines lines firstnumber maxln else lines + -- Collect the lines we want to print into one String. + let sourceRanges = concat $ getSourceRanges numbered range + return $ ItemDocumentContainer $ DocumentMetaContainer ([ ("type", "source"), ("language", language)]) ([ItemWord sourceRanges]) "label" -> handleLab args "ref" -> handleRef args "imgref" -> handleImgRef args diff --git a/markupParser/markupParser.cabal b/markupParser/markupParser.cabal index 1490d95..60ea157 100644 --- a/markupParser/markupParser.cabal +++ b/markupParser/markupParser.cabal @@ -23,6 +23,7 @@ library , json >=0.7 , transformers >=0.3 , indents >=0.3 && < 0.4 + , split >=0.2 Executable parseUdoc Main-is: parseUdoc.hs @@ -34,3 +35,4 @@ Executable parseUdoc , transformers >=0.3 , indents >=0.3 && < 0.4 , markupParser + , split >=0.2 diff --git a/markupParser/test.udoc b/markupParser/test.udoc index d0b5283..a00b64a 100644 --- a/markupParser/test.udoc +++ b/markupParser/test.udoc @@ -23,3 +23,24 @@ And [b]here[/b] is something in bold. And a line[br] break. Escaping also works: \[foobar\] ## Now we have a section with a real long headline. The question is: will it be rendered corrently? + +[source] +Unnumbered source +code +. +[/source] + +[source numbers=True, firstnumber=9, range="9-14,18-20,15-16"] +numbered source 09 +numbered source 10 +foo. 11 +bar. 12 +the 13 +the 14 +the 15 +the 16 +the 17 +the 18 +the 19 +the 20 +[/source]