content: -----------------------------------------------------------
  -- |
  -- Module      :  DBInfo
  -- Copyright   :  HWT Group (c) 2004, haskelldb-users@lists.sourceforge.net
  -- License     :  BSD-style
  -- 
  -- Maintainer  :  haskelldb-users@lists.sourceforge.net
  -- Stability   :  experimental
  -- Portability :  non-portable
  --
  -- This is the "core" file of the DBSpec files. It defines
  -- a DBInfo and important functions on it.
  --
  -- 
  -----------------------------------------------------------
  
  module Database.HaskellDB.DBSpec.DBInfo
      (DBInfo(..),TInfo(..),CInfo(..),DBOptions(..),makeDBSpec,
       makeTInfo,makeCInfo,ppDBInfo,ppTInfo,ppCInfo,ppDBOptions,
       dbInfoToDoc,finalizeSpec,constructNonClashingDBInfo)
      where
  
  import Prelude hiding ((<>))
  import qualified Database.HaskellDB.DBSpec.PPHelpers as PP
  import Database.HaskellDB.FieldType (FieldDesc, FieldType(BStrT, StringT), )
  import Data.Char (toLower, isAlpha)
  import Text.PrettyPrint.HughesPJ
  
  -- | Defines a database layout, top level
  data DBInfo = DBInfo {dbname :: String -- ^ The name of the database
  		     ,opts :: DBOptions  -- ^ Any options (i.e whether to use
  					 --   Bounded Strings)
  		     ,tbls :: [TInfo]    -- ^ Tables this database contains
  		     }
  	      deriving (Show)
  
  data TInfo = TInfo {tname :: String  -- ^ The name of the table
  		   ,cols :: [CInfo]  -- ^ The columns in this table
  		   }
  	      deriving (Eq,Show)
  data CInfo = CInfo {cname :: String    -- ^ The name of this column
  		   ,descr :: FieldDesc -- ^ The description of this column
  		   }
  	     deriving (Eq,Show)
  
  data DBOptions = DBOptions
  		   {useBString :: Bool -- ^ Use Bounded Strings?
  		   ,makeIdent  :: PP.MakeIdentifiers -- ^ Conversion routines from Database identifiers to Haskell identifiers
  		   }
  
  instance Show DBOptions where
     showsPrec p opts =
        showString "DBOptions {useBString = " .
        shows (useBString opts) .
        showString "}"
  
  
  -- | Creates a valid declaration of a DBInfo. The variable name will be the
  --   same as the database name
  dbInfoToDoc :: DBInfo -> Doc
  dbInfoToDoc dbi@(DBInfo {dbname = n
                          , opts = opt}) 
      = fixedName <+> text ":: DBInfo"
        $$ fixedName <+> equals <+> ppDBInfo dbi
        where fixedName = text . PP.identifier (makeIdent opt) $ n
  
  -- | Pretty prints a DBInfo
  ppDBInfo :: DBInfo -> Doc
  ppDBInfo (DBInfo {dbname=n, opts=o, tbls = t}) 
      = text "DBInfo" <+> 
  	 braces (vcat (punctuate comma (
  		 text "dbname =" <+> doubleQuotes (text n) :
  		 text "opts =" <+> ppDBOptions o :
  		 text "tbls =" <+> 
  		 brackets (vcat (punctuate comma (map ppTInfo t))) : [])))
  
  ppTInfo :: TInfo -> Doc
  ppTInfo (TInfo {tname=n,cols=c})
      = text "TInfo" <+> 
        braces (vcat (punctuate comma (
  		 text "tname =" <+> doubleQuotes (text n) :
  		 text "cols =" <+> 
  		 brackets (vcat (punctuate comma (map ppCInfo c))) : [])))
  
  ppCInfo :: CInfo -> Doc
  ppCInfo (CInfo {cname=n,descr=(val,null)})
      = text "CInfo" <+>
        braces (vcat (punctuate comma (
  	         text "cname =" <+> doubleQuotes (text n) :
  		 text "descr =" <+> 
  		 parens (text (show val) <> comma <+> text (show null)) : [])))
  
  ppDBOptions :: DBOptions -> Doc
  ppDBOptions (DBOptions {useBString = b})
      = text "DBOptions" <+>
        braces (text "useBString =" <+> text (show b))
  
  -- | Does a final "touching up" of a DBInfo before it is used by i.e DBDirect.
  -- This converts any Bounded Strings to ordinary strings if that flag is set.
  finalizeSpec :: DBInfo -> DBInfo
  finalizeSpec dbi = if (useBString (opts dbi)) then 
  		   dbi else stripBStr dbi
  
  -- | Converts all BStrings to ordinary Strings
  stripBStr :: DBInfo -> DBInfo
  stripBStr dbi = fixTables dbi
      where
      fixTables dbi = dbi{tbls=map fixCols (tbls dbi)}
      fixCols tbl = tbl{cols=map oneCol (cols tbl)}
      oneCol col = col{descr = fixDescr (descr col)}
      fixDescr col = case fst col of
  		       BStrT _ -> (StringT,snd col)
  		       _       -> col
  
  -- | Creates a DBInfo
  makeDBSpec :: String -- ^ The name of the Database
  	   -> DBOptions -- ^ Options
  	   -> [TInfo]  -- ^ Tables
  	   -> DBInfo -- ^ The generated DBInfo
  makeDBSpec name opt tinfos
      = DBInfo {dbname = name, opts = opt, tbls = tinfos}
  
  -- | Creates a TInfo
  makeTInfo :: String -- ^ The table name
  	  -> [CInfo] -- ^ Columns 
  	  -> TInfo -- ^ The generated TInfo
  makeTInfo name cinfs
      = TInfo {tname = name, cols = cinfs}
  
  -- | Creates a CInfo
  makeCInfo :: String -- ^ The column name
  	  -> FieldDesc -- ^ What the column contains
  	  -> CInfo -- ^ The generated CInfo
  makeCInfo name fdef
      = CInfo {cname = name, descr = fdef}
  
  -----------------------------------------------------
  -- Functions for avoiding nameclashes
  -----------------------------------------------------
  
  -- | Constructs a DBInfo that doesn't cause nameclashes
  constructNonClashingDBInfo :: DBInfo -> DBInfo
  constructNonClashingDBInfo dbinfo = 
      let db' = makeDBNameUnique dbinfo
      in  if equalObjectNames db' (makeDBNameUnique db')
            then db'
  	  else constructNonClashingDBInfo db'
  
  equalObjectNames :: DBInfo -> DBInfo -> Bool
  equalObjectNames db1 db2 =
     dbname db1 == dbname db2 &&
     tbls db1 == tbls db2
  
  -- | Makes a table name unique among all other table names
  makeTblNamesUnique :: [TInfo] -> [TInfo]
  makeTblNamesUnique [] = []
  makeTblNamesUnique (t:[]) = t:[]
  makeTblNamesUnique (t:tt:ts)
      | compNames (tname t) (tname tt) 
  	= t: (makeTblNamesUnique ((tblNewName tt) : ts))
      | True = t : makeTblNamesUnique (tt:ts)
      where 
      tblNewName tinfo@TInfo{tname=n} = tinfo{tname=newName (Left n)}
  
  -- | Makes a field name unique among all other field names
  makeFieldNamesUnique :: [CInfo] -> [CInfo]
  makeFieldNamesUnique [] = []
  makeFieldNamesUnique (f:[]) = f:[]
  makeFieldNamesUnique (f:ff:fs)
      | compNames (cname f) (cname ff) 
  	= f: (makeFieldNamesUnique ((fNewName ff) :fs))
      | True = f : makeFieldNamesUnique (ff:fs)
      where 
      fNewName cinfo@CInfo{cname=n} = cinfo{cname=newName (Right n)}
  
  -- | makes the dbname unique in a database
  makeDBNameUnique :: DBInfo -> DBInfo
  makeDBNameUnique dbinfo 
      = dbinfo{tbls=map (makeTblNameUnique (dbname dbinfo)) (tbls dbinfo)}
  
  -- | makes a supplied name unique in a table and its subfields
  makeTblNameUnique :: String -> TInfo -> TInfo
  makeTblNameUnique s tinfo
      | compNames s (tname tinfo) = 
  	tinfo{cols=map (makeFieldNameUnique s) 
  	      (cols tinfo{tname=newName (Left (tname tinfo))})}
      | True = tinfo{cols=map (makeFieldNameUnique s) (cols tinfo)}
  
  -- | makes a supplied name unique in a field
  makeFieldNameUnique :: String -> CInfo -> CInfo
  makeFieldNameUnique s cinfo 
      | compNames s (cname cinfo) = cinfo{cname=newName (Right (cname cinfo))}
      | True = cinfo
  
  -- | Gives a String a new name, according to its type
  newName :: Either String String -- ^ Either a Table or a Field
  	-> String -- ^ The new name
  newName (Left t) = t ++ "T"
  newName (Right n) = n ++ "F"
  
  -- | Case insensitive String comparison (there probably is a standard function
  --   for this, there ought to be anyway
  compNames :: String -> String -> Bool
  compNames s1 s2 = map toLower s1 == map toLower s2
  