{-# LANGUAGE PatternGuards #-} module Recipe.Haddock( haddockToHTML, haddockHacks ) where import General.Base import General.Web import qualified Text.Read as R data Chunk = Verb [String] | Blk [String] | Li [String] | Numb [String] | Defn [(String,String)] | Para String deriving (Ord,Eq) haddockToHTML :: String -> [String] haddockToHTML = intercalate [""] . map (concatMap linewrap . convert) . join . map classify . paragraphs . lines where empty = all isSpace para = unwords . map trim paragraphs = filter (not . all empty) . groupBy (\x y -> not (empty x) && not (empty y)) classify xs = case trim (head xs) of "@" | trim (last xs) == "@", length xs > 1 -> Blk $ tail $ init xs '>':_ | all ((">" `isPrefixOf`) . ltrim) xs -> Verb $ map (tail . ltrim) xs '[':ys | (cs, ']':zs) <- break (==']') ys -> Defn [(trim cs, para $ zs : tail xs)] '*':ys -> Li [para $ ys : tail xs] '-':ys -> Li [para $ ys : tail xs] '(':ys | (cs, ')':zs) <- break (==')') ys , all isDigit cs -> Numb [para $ zs : tail xs] c:ys | isDigit c , '.':zs <- dropWhile isDigit ys -> Numb [para $ zs : tail xs] _ -> Para $ para xs join (Li xs : Li ys : zs) = join $ Li (xs ++ ys) : zs join (Numb xs : Numb ys : zs) = join $ Numb (xs ++ ys) : zs join (Defn xs : Defn ys : zs) = join $ Defn (xs ++ ys) : zs join (x : ys) = x : join ys join [] = [] convert (Verb xs) = ["
"] ++ map escapeHTML xs ++ [""] convert (Blk xs) = ["
"] ++ map parseInline xs ++ [""] convert (Li xs) = ["