----------------------------------------------------------------------------- -- Copyright 2010, Open Universiteit Nederland. This file is distributed -- under the terms of the GNU General Public License. For more information, -- see the file "LICENSE.txt", which is included in the distribution. ----------------------------------------------------------------------------- -- | -- Maintainer : bastiaan.heeren@ou.nl -- Stability : provisional -- Portability : portable (depends on ghc) -- ----------------------------------------------------------------------------- module Documentation.DefaultPage where import Common.Context import Common.Exercise import Common.Transformation import Control.Monad import Service.DomainReasoner import Service.ServiceList import System.Directory import System.FilePath import Text.HTML import qualified Text.XML as XML import Data.Char generatePage :: String -> String -> HTMLBuilder -> DomainReasoner () generatePage = generatePageAt 0 generatePageAt :: Int -> String -> String -> HTMLBuilder -> DomainReasoner () generatePageAt n dir txt body = do version <- getFullVersion let filename = dir ++ "/" ++ txt dirpart = takeDirectory filename doc = defaultPage version (findTitle body) n body liftIO $ do putStrLn $ "Generating " ++ filename unless (null dirpart) (createDirectoryIfMissing True dirpart) writeFile filename (showHTML doc) defaultPage :: String -> String -> Int -> HTMLBuilder -> HTML defaultPage version title level builder = htmlPage title (Just (up level ++ "ideas.css")) $ do header level builder footer version header :: Int -> HTMLBuilder header level = center $ do let f m = text "[" >> space >> m >> space >> text "]" f $ link (up level ++ exerciseOverviewPageFile) $ text "Exercises" replicateM_ 5 space f $ link (up level ++ "services.html") $ text "Services" replicateM_ 5 space f $ link (up level ++ "tests.html") $ text "Tests" replicateM_ 5 space f $ link (up level ++ "coverage/hpc_index.html") $ text "Coverage" replicateM_ 5 space f $ link (up level ++ "api/index.html") $ text "API" hr footer :: String -> HTMLBuilder footer version = do hr italic $ text $ "Automatically generated from sources: " ++ version up :: Int -> String up = concat . flip replicate "../" findTitle :: HTMLBuilder -> String findTitle = maybe "" XML.getData . XML.findChild "h1" . XML.makeXML "page" ------------------------------------------------------------ -- Paths and files ruleImagePath :: Exercise a -> String ruleImagePath ex = "exercises/" ++ f (domain (exerciseCode ex)) ++ "/" ++ f (description ex) ++ "/" where f = filter isAlphaNum . map toLower exercisePagePath :: ExerciseCode -> String exercisePagePath code = "exercises/" ++ domain code ++ "/" servicePagePath :: String servicePagePath = "services/" ruleImageFile :: Exercise a -> Rule (Context a) -> String ruleImageFile ex r = ruleImagePath ex ++ "rule" ++ name r ++ ".png" ruleImageFileHere :: Exercise a -> Rule (Context a) -> String ruleImageFileHere ex r = filter (not . isSpace) (identifier (exerciseCode ex)) ++ "/rule" ++ filter isAlphaNum (name r) ++ ".png" exerciseOverviewPageFile :: String exerciseOverviewPageFile = "exercises.html" exerciseOverviewAllPageFile :: String exerciseOverviewAllPageFile = "exercises-all.html" serviceOverviewPageFile :: String serviceOverviewPageFile = "services.html" exercisePageFile :: ExerciseCode -> String exercisePageFile code = exercisePagePath code ++ filter (not . isSpace) (identifier code) ++ ".html" exerciseStrategyFile :: ExerciseCode -> String exerciseStrategyFile code = exercisePagePath code ++ filter (not . isSpace) (identifier code) ++ "-strategy.html" exerciseRulesFile :: ExerciseCode -> String exerciseRulesFile code = exercisePagePath code ++ filter (not . isSpace) (identifier code) ++ "-rules.html" exerciseDerivationsFile :: ExerciseCode -> String exerciseDerivationsFile code = exercisePagePath code ++ filter (not . isSpace) (identifier code) ++ "-derivations.html" servicePageFile :: Service -> String servicePageFile srv = servicePagePath ++ serviceName srv ++ ".html" ------------------------------------------------------------ -- Utility functions showBool :: Bool -> String showBool b = if b then "yes" else "no"