Move sources under haddock-api/src

1 files changed, 0 insertions, 209 deletions

diff --git a/src/Haddock/Backends/Xhtml/Themes.hs b/src/Haddock/Backends/Xhtml/Themes.hs
deleted file mode 100644
index 79b093ec..00000000
--- a/src/Haddock/Backends/Xhtml/Themes.hs
+++ /dev/null
@@ -1,209 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  Haddock.Backends.Html.Themes
--- Copyright   :  (c) Mark Lentczner 2010
--- License     :  BSD-like
---
--- Maintainer  :  haddock@projects.haskell.org
--- Stability   :  experimental
--- Portability :  portable
------------------------------------------------------------------------------
-module Haddock.Backends.Xhtml.Themes (
-    Themes,
-    getThemes,
-
-    cssFiles, styleSheet
-    )
-    where
-
-import Haddock.Options
-
-import Control.Applicative
-import Control.Monad (liftM)
-import Data.Char (toLower)
-import Data.Either (lefts, rights)
-import Data.List (nub)
-import Data.Maybe (isJust, listToMaybe)
-
-import System.Directory
-import System.FilePath
-import Text.XHtml hiding ( name, title, p, quote, (</>) )
-import qualified Text.XHtml as XHtml
-
-
---------------------------------------------------------------------------------
--- * CSS Themes
---------------------------------------------------------------------------------
-
-data Theme = Theme {
-  themeName :: String,
-  themeHref :: String,
-  themeFiles :: [FilePath]
-  }
-
-type Themes = [Theme]
-
-type PossibleTheme = Either String Theme
-type PossibleThemes = Either String Themes
-
-
--- | Find a theme by name (case insensitive match)
-findTheme :: String -> Themes -> Maybe Theme
-findTheme s = listToMaybe . filter ((== ls).lower.themeName)
-  where lower = map toLower
-        ls = lower s
-
-
--- | Standard theme used by default
-standardTheme :: FilePath -> IO PossibleThemes
-standardTheme libDir = liftM (liftEither (take 1)) (defaultThemes libDir)
-
-
--- | Default themes that are part of Haddock; added with --default-themes
--- The first theme in this list is considered the standard theme.
--- Themes are "discovered" by scanning the html sub-dir of the libDir,
--- and looking for directories with the extension .theme or .std-theme.
--- The later is, obviously, the standard theme.
-defaultThemes :: FilePath -> IO PossibleThemes
-defaultThemes libDir = do
-  themeDirs <- getDirectoryItems (libDir </> "html")
-  themes <- mapM directoryTheme $ discoverThemes themeDirs
-  return $ sequenceEither themes
-  where
-    discoverThemes paths =
-      filterExt ".std-theme" paths ++ filterExt ".theme" paths
-    filterExt ext = filter ((== ext).takeExtension)
-
-
--- | Build a theme from a single .css file
-singleFileTheme :: FilePath -> IO PossibleTheme
-singleFileTheme path =
-  if isCssFilePath path
-      then retRight $ Theme name file [path]
-      else errMessage "File extension isn't .css" path
-  where
-    name = takeBaseName path
-    file = takeFileName path
-
-
--- | Build a theme from a directory
-directoryTheme :: FilePath -> IO PossibleTheme
-directoryTheme path = do
-  items <- getDirectoryItems path
-  case filter isCssFilePath items of
-    [cf] -> retRight $ Theme (takeBaseName path) (takeFileName cf) items
-    [] -> errMessage "No .css file in theme directory" path
-    _ -> errMessage "More than one .css file in theme directory" path
-
-
--- | Check if we have a built in theme
-doesBuiltInExist :: IO PossibleThemes -> String -> IO Bool
-doesBuiltInExist pts s = fmap (either (const False) test) pts
-  where test = isJust . findTheme s
-
-
--- | Find a built in theme
-builtInTheme :: IO PossibleThemes -> String -> IO PossibleTheme
-builtInTheme pts s = either Left fetch <$> pts
-  where fetch = maybe (Left ("Unknown theme: " ++ s)) Right . findTheme s
-
-
---------------------------------------------------------------------------------
--- * CSS Theme Arguments
---------------------------------------------------------------------------------
-
--- | Process input flags for CSS Theme arguments
-getThemes :: FilePath -> [Flag] -> IO PossibleThemes
-getThemes libDir flags =
-  liftM concatEither (mapM themeFlag flags) >>= someTheme
-  where
-    themeFlag :: Flag -> IO (Either String Themes)
-    themeFlag (Flag_CSS path) = (liftM . liftEither) (:[]) (theme path)
-    themeFlag (Flag_BuiltInThemes) = builtIns
-    themeFlag _ = retRight []
-
-    theme :: FilePath -> IO PossibleTheme
-    theme path = pick path
-      [(doesFileExist,              singleFileTheme),
-       (doesDirectoryExist,         directoryTheme),
-       (doesBuiltInExist builtIns,  builtInTheme builtIns)]
-      "Theme not found"
-
-    pick :: FilePath
-      -> [(FilePath -> IO Bool, FilePath -> IO PossibleTheme)] -> String
-      -> IO PossibleTheme
-    pick path [] msg = errMessage msg path
-    pick path ((test,build):opts) msg = do
-      pass <- test path
-      if pass then build path else pick path opts msg
-
-
-    someTheme :: Either String Themes -> IO (Either String Themes)
-    someTheme (Right []) = standardTheme libDir
-    someTheme est = return est
-
-    builtIns = defaultThemes libDir
-
-
-errMessage :: String -> FilePath -> IO (Either String a)
-errMessage msg path = return (Left msg')
-  where msg' = "Error: " ++ msg ++ ": \"" ++ path ++ "\"\n"
-
-
-retRight :: a -> IO (Either String a)
-retRight = return . Right
-
-
---------------------------------------------------------------------------------
--- * File Utilities
---------------------------------------------------------------------------------
-
-
-getDirectoryItems :: FilePath -> IO [FilePath]
-getDirectoryItems path =
-  map (combine path) . filter notDot <$> getDirectoryContents path
-  where notDot s = s /= "." && s /= ".."
-
-
-isCssFilePath :: FilePath -> Bool
-isCssFilePath path = takeExtension path == ".css"
-
-
---------------------------------------------------------------------------------
--- * Style Sheet Utilities
---------------------------------------------------------------------------------
-
-cssFiles :: Themes -> [String]
-cssFiles ts = nub $ concatMap themeFiles ts
-
-
-styleSheet :: Themes -> Html
-styleSheet ts = toHtml $ zipWith mkLink rels ts
-  where
-    rels = "stylesheet" : repeat "alternate stylesheet"
-    mkLink aRel t =
-      thelink
-        ! [ href (themeHref t),  rel aRel, thetype "text/css",
-            XHtml.title (themeName t)
-          ]
-        << noHtml
-
---------------------------------------------------------------------------------
--- * Either Utilities
---------------------------------------------------------------------------------
-
--- These three routines are here because Haddock does not have access to the
--- Control.Monad.Error module which supplies the Functor and Monad instances
--- for Either String.
-
-sequenceEither :: [Either a b] -> Either a [b]
-sequenceEither es = maybe (Right $ rights es) Left (listToMaybe (lefts es))
-
-
-liftEither :: (b -> c) -> Either a b -> Either a c
-liftEither f = either Left (Right . f)
-
-
-concatEither :: [Either a [b]] -> Either a [b]
-concatEither = liftEither concat . sequenceEither
-