+
module HaddockUtils where
import HsSyn
-- NB. The headers must be given in the order Module, Description,
-- Copyright, License, Maintainer, Stability, Portability, except that
-- any or all may be omitted.
-parseModuleHeader :: String -> Either String (String, HaddockModInfo RdrName)
-parseModuleHeader str0 =
- let
- getKey :: String -> String -> (Maybe String,String)
- getKey key str = case parseKey key str of
- Nothing -> (Nothing,str)
- Just (value,rest) -> (Just value,rest)
-
- (moduleOpt,str1) = getKey "Module" str0
- (descriptionOpt,str2) = getKey "Description" str1
- (copyrightOpt,str3) = getKey "Copyright" str2
- (licenseOpt,str4) = getKey "License" str3
- (licenceOpt,str5) = getKey "Licence" str4
- (maintainerOpt,str6) = getKey "Maintainer" str5
- (stabilityOpt,str7) = getKey "Stability" str6
- (portabilityOpt,str8) = getKey "Portability" str7
-
- description1 :: Either String (Maybe (HsDoc RdrName))
- description1 = case descriptionOpt of
- Nothing -> Right Nothing
- Just description -> case parseHaddockString . tokenise $ description of
-
- Left mess -> Left ("Cannot parse Description: " ++ mess)
- Right doc -> Right (Just doc)
- in
- case description1 of
- Left mess -> Left mess
- Right docOpt -> Right (str8,HaddockModInfo {
- hmi_description = docOpt,
- hmi_portability = portabilityOpt,
- hmi_stability = stabilityOpt,
- hmi_maintainer = maintainerOpt
+parseModuleHeader :: String -> Either String (String, HaddockModInfo RdrName)
+parseModuleHeader str0 =
+ let
+ getKey :: String -> String -> (Maybe String,String)
+ getKey key str = case parseKey key str of
+ Nothing -> (Nothing,str)
+ Just (value,rest) -> (Just value,rest)
+
+ (_moduleOpt,str1) = getKey "Module" str0
+ (descriptionOpt,str2) = getKey "Description" str1
+ (_copyrightOpt,str3) = getKey "Copyright" str2
+ (_licenseOpt,str4) = getKey "License" str3
+ (_licenceOpt,str5) = getKey "Licence" str4
+ (maintainerOpt,str6) = getKey "Maintainer" str5
+ (stabilityOpt,str7) = getKey "Stability" str6
+ (portabilityOpt,str8) = getKey "Portability" str7
+
+ description1 :: Either String (Maybe (HsDoc RdrName))
+ description1 = case descriptionOpt of
+ Nothing -> Right Nothing
+ Just description -> case parseHaddockString . tokenise $ description of
+
+ MyLeft mess -> Left ("Cannot parse Description: " ++ mess)
+ MyRight doc -> Right (Just doc)
+ in
+ case description1 of
+ Left mess -> Left mess
+ Right docOpt -> Right (str8,HaddockModInfo {
+ hmi_description = docOpt,
+ hmi_portability = portabilityOpt,
+ hmi_stability = stabilityOpt,
+ hmi_maintainer = maintainerOpt
})
-- | This function is how we read keys.
--
-- all fields in the header are optional and have the form
--
--- [spaces1][field name][spaces] ":"
+-- [spaces1][field name][spaces] ":"
-- [text]"\n" ([spaces2][space][text]"\n" | [spaces]"\n")*
-- where each [spaces2] should have [spaces1] as a prefix.
--
-- > description
-- >
-- > The module comment starts here
---
+--
-- the value will be "this is a .. description" and the rest will begin
-- at "The module comment".
parseKey :: String -> String -> Maybe (String,String)
return (scanKey True indentation afterColon1)
where
scanKey :: Bool -> String -> String -> (String,String)
- scanKey isFirst indentation [] = ([],[])
+ scanKey _ _ [] = ([],[])
scanKey isFirst indentation str =
let
(nextLine,rest1) = extractNextLine str
(_,[]) -> True
_ -> False
in
- if accept
+ if accept
then
let
(scanned1,rest2) = scanKey False indentation rest1
- scanned2 = case scanned1 of
+ scanned2 = case scanned1 of
"" -> if allSpaces then "" else nextLine
_ -> nextLine ++ "\n" ++ scanned1
in
extractLeadingSpaces :: String -> (String,String)
extractLeadingSpaces [] = ([],[])
- extractLeadingSpaces (s@(c:cs))
- | isSpace c =
+ extractLeadingSpaces (s@(c:cs))
+ | isSpace c =
let
(spaces1,cs1) = extractLeadingSpaces cs
in
extractNextLine :: String -> (String,String)
extractNextLine [] = ([],[])
- extractNextLine (c:cs)
+ extractNextLine (c:cs)
| c == '\n' =
([],cs)
| True =
(line,rest) = extractNextLine cs
in
(c:line,rest)
-
-
- -- indentation returns characters after last newline.
- indentation :: String -> String
- indentation s = fromMaybe s (indentation0 s)
- where
- indentation0 :: String -> Maybe String
- indentation0 [] = Nothing
- indentation0 (c:cs) =
- case indentation0 cs of
- Nothing -> if c == '\n' then Just cs else Nothing
- in0 -> in0
-
+
-- comparison is case-insensitive.
extractPrefix :: String -> String -> Maybe String
extractPrefix [] s = Just s
- extractPrefix s [] = Nothing
+ extractPrefix _ [] = Nothing
extractPrefix (c1:cs1) (c2:cs2)
| toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
| True = Nothing