Make.hs

-----------------------------------------------------------------------------
-- 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.Make (DocItem(..), makeDocumentation) where

import Common.TestSuite
import Common.Utils (Some(..))
import Control.Monad
import Data.Maybe
import Service.DomainReasoner
import Documentation.SelfCheck
import Documentation.ExercisePage
import Documentation.RulePage
import Documentation.TestsPage
import Documentation.ServicePage
import Documentation.OverviewPages

data DocItem = Pages | SelfCheck | BlackBox (Maybe String)
   deriving Eq

makeDocumentation :: String -> String -> DocItem -> DomainReasoner ()
makeDocumentation docDir testDir item =
   case item of
      Pages -> do 
         report "Generating overview pages"
         makeOverviewExercises docDir
         makeOverviewServices  docDir
         report "Generating exercise pages"
         pkgs <- getPackages
         forM_ pkgs $ \(Some pkg) -> 
            makeExercisePage docDir pkg
         report "Generating rule pages"
         makeRulePages docDir
         report "Generating service pages"
         getServices >>= mapM_ (makeServicePage docDir)
         report "Running tests"
         makeTestsPage docDir testDir
      SelfCheck -> do
         checks <- selfCheck testDir
         result <- liftIO (runTestSuiteResult checks)
         liftIO (printSummary result)
      BlackBox mdir -> do
         run    <- runWithCurrent
         checks <- liftIO $ blackBoxTests run (fromMaybe testDir mdir)
         result <- liftIO $ runTestSuiteResult checks
         liftIO (printSummary result)
         
report :: String -> DomainReasoner ()
report s = liftIO $ do
   let line = replicate 75 '-'
   putStrLn line
   putStrLn ("--- " ++ s)
   putStrLn line