{-# 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)