Fix most of the warnings in index.hs
authorIan Lynagh <igloo@earth.li>
Tue, 28 May 2013 23:53:16 +0000 (23:53 +0000)
committerIan Lynagh <igloo@earth.li>
Tue, 28 May 2013 23:53:16 +0000 (23:53 +0000)
tools/Makefile
tools/index.hs

index 9a85c33..90ad1ee 100644 (file)
@@ -26,7 +26,7 @@ verb-tex4ht: verb-tex4ht.o
        $(CC) -o $@ $^
 
 run_index: index.hs
-       $(GHC) -o run_index index.hs
+       $(GHC) -o run_index index.hs -Wall
 
 clean:
        rm -f verbatim verb-tex4ht run_tex run_index *.o *.hi
index 0314536..9f79151 100644 (file)
@@ -7,15 +7,17 @@
 module Main where
 
 import Data.Char
-import System.IO
 import System.IO.Error
 
+main :: IO ()
 main = do refs <- readRefFile "reportrefs"
           doFiles refs ["prelude-index"]
 
-doFiles r files = do mapM (doFile r) files
+doFiles :: Refs -> [FilePath] -> IO ()
+doFiles r files = do mapM_ (doFile r) files
                      putStrLn "Done."
 
+doFile :: Refs -> FilePath -> IO ()
 doFile r f = catchIOError
                (do putStrLn ("Reading " ++ f ++ ".idx")
                    ls <- readFile (f ++ ".idx")
@@ -29,8 +31,11 @@ doFile r f = catchIOError
 
 type Refs = [(String,String)]
 
+expandAllRefs :: Refs -> [String] -> [String]
 expandAllRefs r ls = expandAll1 r False ls
-expandAll1 r table [] = []
+
+expandAll1 :: Refs -> Bool -> [String] -> [String]
+expandAll1 _ _     [] = []
 expandAll1 r table (l:ls) | l == "#table" = expandAll1 r True ls
                           | l == "#endtable" = expandAll1 r False ls
                           | table = ("<tr><td><tt>" ++ nbspaces (expandRefs r l)
@@ -39,71 +44,84 @@ expandAll1 r table (l:ls) | l == "#table" = expandAll1 r True ls
  where rest = expandAll1 r table ls
 
 expandRefs :: Refs -> String -> String
-expandRefs r "" = ""
+expandRefs _ "" = ""
 expandRefs r ('#':l) = expandRef r "" l
 expandRefs r (c:cs) = c : expandRefs r cs
 
+expandRef :: Refs -> String -> String -> String
 expandRef r txt ('V':l) = expandVar r txt (parseRef l)
 expandRef r txt ('I':l) = expandInstance r txt (parseRef l)
 expandRef r txt ('T':l) = expandTycon r txt (parseRef l)
 expandRef r txt ('L':l) = expandLink r txt (parseRef l)
 expandRef r txt ('S':l) = expandSect r txt (parseRef l)
-expandRef r txt ('&':l) = "</tt></td><td><tt>" ++ expandRefs r l
-expandRef r txt ('#':l) = "#" ++ expandRefs r l
-expandRef r txt ('.':l) = expandRefs r l
-expandRef r txt l = error ("Bad ref:" ++ l ++ "\n")
+expandRef r _   ('&':l) = "</tt></td><td><tt>" ++ expandRefs r l
+expandRef r _   ('#':l) = "#" ++ expandRefs r l
+expandRef r _   ('.':l) = expandRefs r l
+expandRef _ _   l = error ("Bad ref:" ++ l ++ "\n")
 
+parseRef :: String -> (String, String)
 parseRef = break (\c -> isSpace c || c == '#')
 
+expandVar :: Refs -> String -> (String, String) -> String
 expandVar r txt (v,rest) = let n = mangleVar v
                                f = lookup n r in
                              case f of
                                Nothing -> trySig r txt v rest n
                                _ -> anchor v f n txt ++ expandRefs r rest
 
+expandTycon :: Refs -> String -> (String, String) -> String
 expandTycon r txt (t,rest) = let n = mangleTycon t
                                  f = lookup n r in
                              anchor t f n txt ++ expandRefs r rest
 
+expandInstance :: Refs -> String -> (String, String) -> String
 expandInstance r txt (c,'#':rest ) = let (t,rest') = parseRef rest
                                          n = mangleInstance c t
                                          f = lookup n r in
                                        anchor c f n txt ++ expandRefs r rest'
-expandInstance r txt (c,l) = error ("bad instance " ++ l ++ "\n")
+expandInstance _ _   (_,l) = error ("bad instance " ++ l ++ "\n")
 
+expandSect :: Refs -> String -> (String, String) -> String
 expandSect r txt (s,rest) = let n = mangleSect s
                                 f = lookup n r in
                               "(see " ++ anchor s f n txt ++ ")" ++
                                expandRefs r rest
 
+expandLink :: Refs -> String -> (String, String) -> String
 expandLink r _ (t,'#':l') = expandRef r t l'
-expandLink r _ (l,l') = error ("Bad link: " ++ l ++ l' ++ "\n")
+expandLink _ _ (l,l') = error ("Bad link: " ++ l ++ l' ++ "\n")
 
+trySig :: Refs -> String -> String -> String -> String -> String
 trySig r txt v rest n =
    let c = parseClass rest
        n = mangleTycon c
        f = lookup n r in
      anchor v f n txt ++ expandRefs r rest
 
-anchor str file tag txt =
-         case file of
+anchor :: String -> Maybe String -> String -> String -> String
+anchor str mfile tag txt =
+         case mfile of
            Just f -> "<a href=\"" ++ f ++ ".html#" ++ tag ++
                       "\">" ++ t ++ "</a>"
            Nothing -> "Bad tag:" ++ tag ++ " " ++ t
      where
        t = htmlS $ if txt == "" then str else txt
 
+mangleVar :: String -> String
 mangleVar n = "$v" ++ mangleName (filter (\c -> not (c `elem` "()")) n)
 
+mangleTycon :: String -> String
 mangleTycon n = "$t" ++ mangleName n
 
+mangleInstance :: String -> String -> String
 mangleInstance c t = "$i" ++ mangleName c ++ "$$" ++ mangleName t
 
+mangleSect :: String -> String
 mangleSect s = "sect" ++ s
 
-
-mangleName r = concat $
-               map (\c -> case c of '(' -> "$P"
+mangleName :: String -> String
+mangleName r = concatMap
+                   (\c -> case c of '(' -> "$P"
                                     ')' -> "$C"
                                     '-' -> "$D"
                                     '[' -> "$B"
@@ -120,11 +138,12 @@ mangleName r = concat $
                                     '=' -> "$Q"
                                     _   -> [c]) r
 
+mangleType :: String -> String
 mangleType t = mangleName (case t of
-                              "(IO" -> "IO"
+                              "(IO"    -> "IO"
                               "(a->b)" -> "->"
-                              "[a]" -> "[]"
-                              x -> x)
+                              "[a]"    -> "[]"
+                              x        -> x)
 
 
 
@@ -136,36 +155,46 @@ readRefFile f = catchIOError
                                 print e
                                 return [])
 
+parseKV :: String -> (String, String)
 parseKV l = let (k,l1) = span (/= '=') l
                 val    = case l1 of
                            ('=':v) -> trim v
                            _       -> ""
               in (trimr k,val)
 
+parseClass :: String -> String
 parseClass s = let s1 = (skip "(" . skip "::") s
                    (c,_) = span isAlpha (trim s1) in
                  c
 
+trim :: String -> String
 trim s = dropWhile isSpace s
+
+trimr :: String -> String
 trimr s = reverse (dropWhile isSpace (reverse s))
+
+starts :: String -> String -> Bool
 starts [] _ = True
 starts _ [] = False
 starts (a:as) (b:bs) | a == b = starts as bs
                      | otherwise = False
 
+skip :: String -> String -> String
 skip val s = if val `starts` (trim s) then
                 drop (length val) (trim s)
              else s
 
-
+htmlEncode :: Char -> String
 htmlEncode '>' = "&gt;"
 htmlEncode '<' = "&lt;"
 htmlEncode '&' = "&amp;"
 htmlEncode c   = [c]
 
-htmlS s = concat (map htmlEncode s)
+htmlS :: String -> String
+htmlS s = concatMap htmlEncode s
 
-nbspaces [] = []
+nbspaces :: String -> String
+nbspaces "" = ""
 nbspaces (' ' : cs) = "&nbsp;" ++ nbspaces cs
 nbspaces ('<':cs) = ['<'] ++ c ++ nbspaces r where
                         (c,r) = span (/= '>') cs