astview-0.1: Setup.hs

#!/usr/bin/runhaskell

import Distribution.Simple
import Distribution.Simple.Setup (ConfigFlags (..))
import Distribution.PackageDescription (emptyHookedBuildInfo,HookedBuildInfo(..))
import Language.Haskell.HsColour (hscolour,Output(CSS))
import Language.Haskell.HsColour.Colourise (defaultColourPrefs)
import Control.Monad
import Data.Maybe
import Data.List

main :: IO ()
main = defaultMainWithHooks hooks

hooks :: UserHooks
hooks = simpleUserHooks { preConf = myPreConf }

myPreConf :: Args -> ConfigFlags -> IO HookedBuildInfo
myPreConf args cf = do
  makedocs 
  return emptyHookedBuildInfo

-- read template file with markers, call replaceOrEcho for each marker
makedocs :: IO ()
makedocs = do
  putStr "Generating custom html documentation... "
  file <- readFile "data/astview-tmpl.html"
  replaced <- mapM replaceOrEcho (lines file)
  putStrLn " done."
  writeFile "data/astview.html" (unlines . concat $ replaced)
  return ()


-- echoes the current line, or, if mymatch succeeds:
-- replaces the line with colourized haskell code.
replaceOrEcho :: String -> IO [String]
replaceOrEcho s = if not $ match s 
  then return [s]
  else do
    putStr $ (extract s)++" "
    file <- readFile ("data/"++(extract s)++".hs")
    let replacement = lines $ hscolour CSS defaultColourPrefs False True (extract s) False file
    return (["<!-- Example "++(extract s)++" follows: -->"]
           ++ replacement
           ++ ["<!-- Example "++(extract s)++" done. -->"])


-- interface that delegates to various implementations:

-- recognizes Template marker of the form "%%asdf%%"
match :: String -> Bool
match = match0 "%%"

--extracts the filename from the marker
extract :: String -> String
extract = extract1 "%%"

--------  Implementations  --------------

match0 :: String -> String -> Bool
match0 p s = take 2 s == p && take 2 (reverse s) == p

match1 :: String -> String -> Bool
match1 p = liftM2 (&&) 
             (help p) 
             (help p . reverse) 
  where help q = (q ==) . (take (length q))

match2 :: String -> String -> Bool
match2 p s = p `isSuffixOf` s && (reverse p) `isPrefixOf` s

extract1 :: String -> String -> String
extract1 p s = let remainder = (drop (length p) s) in reverse (drop (length p) (reverse remainder) )

extract2 :: String -> String -> String
extract2 p s = reverse (drop (length p) (reverse (drop (length p) s)))


extract3 :: String -> String -> String
extract3 p s = reverse . drop (length p) $ reverse $ drop (length p) s


extract4 :: String -> String
extract4 = help . reverse . help
  where help :: String -> String
        help = fromJust . (stripPrefix "%%%")