content: -----------------------------------------------------------
  -- |
  -- Module      :  PPHelpers
  -- Copyright   :  HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net
  -- License     :  BSD-style
  --
  -- Maintainer  :  haskelldb-users@lists.sourceforge.net
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -- Various functions used when pretty printing stuff
  --
  --
  -----------------------------------------------------------
  module Database.HaskellDB.DBSpec.PPHelpers where
  -- no explicit export, we want ALL of it
  
  import Data.Char (toLower, toUpper, isAlpha, isAlphaNum, )
  import Text.PrettyPrint.HughesPJ
  
  newline = char '\n'
  
  -----------------------------------------------------------
  -- Comment that looks like this
  -----------------------------------------------------------
  ppComment txt
  	= commentLine $$ vcat (map commentText txt) $$ commentLine
  	where
  	  commentLine	= text (replicate 75 '-')
  	  commentText s	= text ("-- " ++ s)
  
  -----------------------------------------------------------
  -- Create valid Names
  -----------------------------------------------------------
  fileName name	| not (elem '.' baseName)  = name ++ ".hs"
  		| otherwise		   = name
  		where
  	          baseName = reverse (takeWhile (/='\\') (reverse name))
  
  
  data MakeIdentifiers =
     MakeIdentifiers
        { moduleName, identifier, toType :: String -> String }
  
  mkIdentPreserving =
     MakeIdentifiers
        {
           moduleName = checkChars . checkUpper,
           identifier = checkChars . checkKeyword . checkLower,
           toType     = checkChars . checkKeyword . checkUpper
        }
  
  mkIdentCamelCase =
     MakeIdentifiers
        {
           moduleName = checkChars . toUpperCamelCase,
           identifier = checkChars . checkKeyword . toLowerCamelCase,
           toType     = checkChars . checkKeyword . toUpperCamelCase
        }
  
  
  toLowerCamelCase s@(_:_) =
     let (h : rest) = split ('_'==) $ dropWhile ('_'==) $ map toLower s
     in  concat $ checkLower h : map (checkUpperDef '_') rest
  toLowerCamelCase [] =
     error "toLowerCamelCase: identifier must be non-empty"
  
  toUpperCamelCase s@(_:_) =
     let (h : rest) = split ('_'==) $ dropWhile ('_'==) $ map toLower s
     in  concat $ checkUpper h : map (checkUpperDef '_') rest
  toUpperCamelCase [] =
     error "toUpperCamelCase: identifier must be non-empty"
  
  {- |
  Generalization of 'words' and 'lines' to any separating character set.
  -}
  split :: Eq a => (a -> Bool) -> [a] -> [[a]]
  split p =
     foldr (\ x yt@(~(y:ys)) -> (if p x then ([]:yt) else ((x:y):ys)) ) [[]]
  
  checkChars s	= map replace s
  		where
  		  replace c	| isAlphaNum c	= c
  		  		| otherwise	= '_'
  
  checkKeyword s	| elem s keywords  = 'x' : s
  		| otherwise	   = s
  		where
  		  keywords	= [ "module", "where", "import"
  		  		  , "infix", "infixr", "infixl"
  		  		  , "type", "newtype", "data"
  		  		  , "deriving"
  		  		  , "class", "instance"
  		  		  , "do", "return"
  		  		  , "let", "in"
  		  		  , "case", "of"
  		  		  , "if", "then", "else"
  		  		  , "id", "zip","baseTable"
  		  		  ]
  
  checkUpper "" = error "Empty name from database?"
  checkUpper s = checkUpperDef 'X' s
  
  checkLower "" = error "Empty name from database?"
  checkLower s = checkLowerDef 'x' s
  
  checkUpperDef _ ""      = ""
  checkUpperDef d s@(x:xs)
  			| isAlpha x	= toUpper x : xs
  			| otherwise	= d : s -- isDigit?
  
  checkLowerDef _ ""      = ""
  checkLowerDef d s@(x:xs)
  			| isAlpha x	= toLower x : xs
  			| otherwise	= d : s -- isDigit?
  