Seperate module for comment parsing.

1 files changed, 31 insertions, 0 deletions

diff --git a/Comments.hs b/Comments.hs
new file mode 100644
index 0000000..25cd7de
--- /dev/null
+++ b/Comments.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE BangPatterns             #-}
+{-# LANGUAGE LambdaCase #-}
+module Comments where
+
+import Control.Arrow
+
+parseComments :: (Num col, Num lin) => lin -> col -> [Char] -> [(lin, col, [Char])]
+parseComments !lin !col = \case
+    ('/':'*':cs) -> let (lcnt,col',bcnt) = findCloser 1 (0,col,0) cs
+                        (xs,cs') = case drop (bcnt-2) cs of
+                            '*':'/':_ -> second (drop 2) $ splitAt (bcnt-2) cs
+                            _         -> splitAt bcnt cs
+                    in mkComment lin col xs : parseComments (lin + lcnt) col' cs'
+    ('/':'/':cs) -> let (comment,ds) = break (=='\n') cs
+                    in mkComment lin col comment : parseComments (lin + 1) 1 cs
+    ('\n' : cs) -> parseComments (lin+1) 1       cs
+    (  x  : cs) -> parseComments lin     (col+1) cs
+    []          -> []
+
+
+findCloser :: (Num a4, Num a3, Num a2, Num a1, Eq a1) =>
+                    a1 -> (a4, a2, a3) -> [Char] -> (a4, a2, a3)
+findCloser !1 (l,c,b) ('*':'/':_)  = (l,c+2,b+2)
+findCloser !d (l,c,b) ('*':'/':xs) = findCloser (d - 1) (l,c+2,b+2) xs
+findCloser !d (l,c,b) ('/':'*':xs) = findCloser (d + 1) (l,c+2,b+2) xs
+findCloser !d (l,c,b) ('\n':xs)    = findCloser d (l+1,1,b+1) xs
+findCloser !d (l,c,b) (_:xs)       = findCloser d (l,c+1,b+1) xs
+findCloser !d (l,c,b) []           = (l,c,b)
+
+mkComment :: a -> b -> c -> (a, b, c)
+mkComment lin no str = (lin,no,str)