Feature/codelines: Add support for numbering source code lines

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

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

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

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]