From c0832e05428299aa8f489074deeff1c041c942c3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Leonard=20Janis=20Robert=20K=C3=B6nig?= Date: Thu, 2 Dec 2021 16:34:15 +0100 Subject: [PATCH 1/5] GHC 8.8.1 removed Monad.fail https://wiki.haskell.org/MonadFail_Proposal --- markupParser/Text/Udoc/Document.hs | 2 +- markupParser/Text/Udoc/DocumentParser.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/markupParser/Text/Udoc/Document.hs b/markupParser/Text/Udoc/Document.hs index 0905f6f..2379b61 100644 --- a/markupParser/Text/Udoc/Document.hs +++ b/markupParser/Text/Udoc/Document.hs @@ -55,7 +55,7 @@ showJSON' (Just x) = showJSON x showJSON' Nothing = JSNull {-| Lookup the JSValue of a map key that may not exist. -} -mLookup :: (Monad m) => String -> [(String, b)] -> m b +mLookup :: (MonadFail m) => String -> [(String, b)] -> m b 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..ced3cf2 100644 --- a/markupParser/Text/Udoc/DocumentParser.hs +++ b/markupParser/Text/Udoc/DocumentParser.hs @@ -259,7 +259,7 @@ 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) => +getArgumentsOrFail :: (MonadFail m, Eq a, Show a) => [(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 +278,7 @@ getArgumentsOrFail mandArgs optArgs aList f = Just m' -> return $ f m' opt {-| Lookup a required tag attribute that may not exist. -} -mLookup :: (Show a, Monad m, Eq a) => a -> [(a , b)] -> String -> m b +mLookup :: (Show a, MonadFail m, Eq a) => a -> [(a , b)] -> String -> m b 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 +293,7 @@ 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) => +handleMetaTag :: (MonadFail m, Show a, Eq a) => String -- ^ The name of the tag type -> [(a, String)] -- ^ Mandatory tag arguments -> [(a, String)] -- ^ Optional tag arguments From 61b834678441985cc27b9ed1da929c9169623927 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Leonard=20Janis=20Robert=20K=C3=B6nig?= Date: Thu, 2 Dec 2021 21:20:02 +0100 Subject: [PATCH 2/5] Put MonadFail behind a GHC feature gate --- markupParser/Text/Udoc/Document.hs | 7 +++++++ markupParser/Text/Udoc/DocumentParser.hs | 13 +++++++++++++ 2 files changed, 20 insertions(+) diff --git a/markupParser/Text/Udoc/Document.hs b/markupParser/Text/Udoc/Document.hs index 2379b61..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 ced3cf2..55f318b 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 @@ -259,7 +260,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. +#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 +283,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 +302,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. +#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 From 9782642006d206f7cac30a6e07b26c5533ab757e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Leonard=20Janis=20Robert=20K=C3=B6nig?= Date: Thu, 2 Dec 2021 15:56:33 +0100 Subject: [PATCH 3/5] Add support for source code lines We add three more properties to the `source element` of the format [source firstnumber=N, range="a-b,c-d", numbers=Bool] The `firstnumber` determines how we remap the first actual input line. By default this is the identity, that is, the first input line is set as first line in the output: `firstnumber=0`. The range specifies what parts of the code we want to print. It depends on the value of `firstnumber`, that is, if we use `firstnumber=10` and `range 11-14` it will print the 2st to 6nd (thx @aluc) line of the input. By default all lines are printed. Finally, we can turn line numbers on or off. --- markupParser/Text/Udoc/DocumentParser.hs | 53 +++++++++++++++++++++++- markupParser/markupParser.cabal | 2 + 2 files changed, 54 insertions(+), 1 deletion(-) diff --git a/markupParser/Text/Udoc/DocumentParser.hs b/markupParser/Text/Udoc/DocumentParser.hs index 55f318b..b790430 100644 --- a/markupParser/Text/Udoc/DocumentParser.hs +++ b/markupParser/Text/Udoc/DocumentParser.hs @@ -40,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 @@ -400,6 +402,44 @@ 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) + +-- | 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)]. +-- TODO clean up this mess and use dataypes + Read? +textRange :: String -> [(Integer, Integer)] +textRange s = map (toRangeTuple.toIntTuple.lsToTuple.splitRangeSep) (splitListSep s) + where splitListSep s = S.splitOn "," s + splitRangeSep s = S.splitOn "-" s + lsToTuple [a,b] = (a,b) + toInt s = read s :: Integer + toIntTuple (a,b) = (toInt a, toInt b) + toRangeTuple (a,b) = (a,b-a+1) + -- | 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. @@ -472,11 +512,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 From 7c1c4d4be6f50d5eecd2fedb93ee63d2a8b04b90 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Leonard=20Janis=20Robert=20K=C3=B6nig?= Date: Thu, 2 Dec 2021 20:54:25 +0100 Subject: [PATCH 4/5] Add testcase for codelines feature --- markupParser/test.udoc | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) 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] From fad85c0c72317bb98c5c2c2dd3e87d153a73e659 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Leonard=20Janis=20Robert=20K=C3=B6nig?= Date: Fri, 3 Dec 2021 18:43:50 +0100 Subject: [PATCH 5/5] textRange: rewrite to use class Read --- markupParser/Text/Udoc/DocumentParser.hs | 33 ++++++++++++++++++------ 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/markupParser/Text/Udoc/DocumentParser.hs b/markupParser/Text/Udoc/DocumentParser.hs index b790430..b804378 100644 --- a/markupParser/Text/Udoc/DocumentParser.hs +++ b/markupParser/Text/Udoc/DocumentParser.hs @@ -427,18 +427,35 @@ 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)]. --- TODO clean up this mess and use dataypes + Read? textRange :: String -> [(Integer, Integer)] -textRange s = map (toRangeTuple.toIntTuple.lsToTuple.splitRangeSep) (splitListSep s) - where splitListSep s = S.splitOn "," s - splitRangeSep s = S.splitOn "-" s - lsToTuple [a,b] = (a,b) - toInt s = read s :: Integer - toIntTuple (a,b) = (toInt a, toInt b) - toRangeTuple (a,b) = (a,b-a+1) +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