|
sourcecode:
|
module CPM.Diff.CurryComments
( readComments
, SourceLine
, getFuncComment
) where
import Data.Char
import Data.List (isSuffixOf)
-- This is adapted from the currydoc source code.
--- Reads the pragma comments from a Curry program.
--- The first component of the result
--- is the comment for the module definition. The second component is a map
--- from different source line types to pragma comments on that source line.
readComments :: String -> IO (String, [(SourceLine, String)])
readComments filename = do
prog <- readFile filename
return (groupLines . filter (/= OtherLine) . map classifyLine . lines $ prog)
data SourceLine = PragmaCmt String
| ModDef
| DataDef String
| FuncDef String
| OtherLine
deriving Eq
classifyLine :: String -> SourceLine
classifyLine line
| take 3 line == "{-#" = PragmaCmt (drop 3 line) -- #-}
| take 7 line == "module " = ModDef
| take 7 line == "import " = ModDef
| otherwise = if null id1
then OtherLine
else if id1 == "data" || id1 == "type" || id1 == "newtype"
then DataDef (getDatatypeName line)
else if "'default" `isSuffixOf` id1
then OtherLine
else FuncDef id1
where
id1 = getFirstId line
getDatatypeName = takeWhile isIdChar . dropWhile (== ' ') . dropWhile isIdChar
getFirstId :: String -> String
getFirstId [] = ""
getFirstId (c:cs)
| isAlpha c = takeWhile isIdChar (c:cs)
| c == '(' = let bracketId = takeWhile (/= ')') cs
in if all (`elem` infixIDs) bracketId
then bracketId
else ""
| otherwise = ""
isIdChar :: Char -> Bool
isIdChar c = isAlphaNum c || c == '_' || c == '\''
infixIDs :: String
infixIDs = "~!@#$%^&*+-=<>?./|\\:"
groupLines :: [SourceLine] -> (String, [(SourceLine, String)])
groupLines sls =
let (modCmts, progCmts) = break (== ModDef) sls
in if progCmts == []
then ("", groupProgLines sls)
else (concatMap getComment modCmts,
groupProgLines (filter (/= ModDef) (tail progCmts)))
where
getComment src = case src of
PragmaCmt cmt -> cmt ++ "\n"
_ -> ""
groupProgLines :: [SourceLine] -> [(SourceLine, String)]
groupProgLines [] = []
groupProgLines (PragmaCmt cmt : sls) = groupComment cmt sls
groupProgLines (FuncDef f : sls) = (FuncDef f, "") : skipFuncDefs f sls
groupProgLines (DataDef d : sls) = (DataDef d, "") : skipDataDefs d sls
groupProgLines (ModDef : sls) = groupProgLines sls
groupProgLines (OtherLine : sls) = groupProgLines sls
groupComment :: String -> [SourceLine] -> [(SourceLine, String)]
groupComment _ [] = []
groupComment cmt (PragmaCmt cmt1 : sls) = groupComment (cmt ++ "\n" ++ cmt1) sls
groupComment cmt (FuncDef f : sls) = (FuncDef f, cmt) : skipFuncDefs f sls
groupComment cmt (DataDef d : sls) = (DataDef d, cmt) : skipDataDefs d sls
groupComment cmt (ModDef : sls) = groupComment cmt sls
groupComment cmt (OtherLine : sls) = groupComment cmt sls
skipFuncDefs :: String -> [SourceLine] -> [(SourceLine, String)]
skipFuncDefs _ [] = []
skipFuncDefs _ (PragmaCmt cmt : sls) = groupProgLines (PragmaCmt cmt : sls)
skipFuncDefs _ (DataDef d : sls) = groupProgLines (DataDef d : sls)
skipFuncDefs f (FuncDef f1 : sls) =
if f == f1 then skipFuncDefs f sls
else groupProgLines (FuncDef f1 : sls)
skipFuncDefs f (ModDef : sls) = skipFuncDefs f sls
skipFuncDefs f (OtherLine : sls) = skipFuncDefs f sls
skipDataDefs :: String -> [SourceLine] -> [(SourceLine, String)]
skipDataDefs _ [] = []
skipDataDefs _ (PragmaCmt cmt : sls) = groupProgLines (PragmaCmt cmt : sls)
skipDataDefs _ (FuncDef f : sls) = groupProgLines (FuncDef f : sls)
skipDataDefs d (DataDef d1 : sls) =
if d == d1 then skipDataDefs d sls
else groupProgLines (DataDef d1 : sls)
skipDataDefs d (ModDef : sls) = skipDataDefs d sls
skipDataDefs d (OtherLine : sls) = skipDataDefs d sls
--- Get the pragma comments for a function from a map from source lines
--- to comments.
getFuncComment :: String -> [(SourceLine, String)] -> String
getFuncComment _ [] = ""
getFuncComment fname ((def, cmt):fdcmts) = case def of
FuncDef f -> if fname == f then cmt else getFuncComment fname fdcmts
_ -> getFuncComment fname fdcmts
|