module Database.ReadableFromDB where
import Control.Exception
import Data.Convertible
import Data.Char
import qualified Data.Map as M
import Data.Map (Map, (!))
import Data.MyHelpers
import Data.Typeable
import Database.HDBC
import Database.HDBC.PostgreSQL
type FieldName = String
type NoMoreThanOne_shoulditbe = Bool
class (Typeable readable, Show pk) => ReadableFromDB readable pk where
readFromDB :: Connection -> pk -> IO [Either AddressedReadFromDBError readable]
parseDBrow :: Connection -> pk -> Map FieldName SqlValue -> IO (Either AddressedReadFromDBError readable)
readOneFromDB :: Connection -> pk -> NoMoreThanOne_shoulditbe -> IO (Either AddressedReadFromDBError readable)
readOneFromDB db_conn pk nomorethanone_shoulditbe = do
results_list <- readFromDB db_conn pk
return $
case results_list of
[] -> wrapParseResult_1row pk $ Left NotFoundInDB_RFDBE
err_or_readable : [] -> err_or_readable
err_or_readable : _ -> case nomorethanone_shoulditbe of
True -> wrapParseResult_1row pk $ Left $ TooManyResultsFoundInDB_RFDBE 1
False -> err_or_readable
type AllowedMaximumOfRowsCount = Int
data ReadFromDBError =
RecieveError_RFDBE SqlError
| NotFoundInDB_RFDBE
| TooManyResultsFoundInDB_RFDBE AllowedMaximumOfRowsCount
| RowParseError_RFDBE SomeException
| SubReadError_RFDBE AddressedReadFromDBError
deriving (Show, Typeable)
data AddressedReadFromDBError = AddressedReadFromDBError {
arfdbeEntityType :: TypeRep
, arfdbePK :: String
, arfdbeErr :: ReadFromDBError
} deriving (Show, Typeable)
wrapParseResult_1row :: (Typeable readable, Show pk) => pk -> Either ReadFromDBError readable -> Either AddressedReadFromDBError readable
wrapParseResult_1row pk err_or_readable =
case err_or_readable of
Right readable -> Right readable
Left err -> Left AddressedReadFromDBError {
arfdbeEntityType = rightType_formReadResOrErr err_or_readable
, arfdbePK = show pk
, arfdbeErr = err
}
wrapParseResult_Nrows :: (Typeable a, Show pk) => pk -> [Either ReadFromDBError a] -> [Either AddressedReadFromDBError a]
wrapParseResult_Nrows pk err_or_a__list = map (wrapParseResult_1row pk) err_or_a__list
rightType_formReadResOrErr :: (Typeable left, Typeable right) => Either left right -> TypeRep
rightType_formReadResOrErr left_or_right = let _ : right_type : [] = typeRepArgs (typeOf left_or_right) in right_type
takeFieldValue :: Convertible SqlValue a => FieldName -> Map FieldName SqlValue -> a
takeFieldValue f_name row_map =
let mb_sqlv = M.lookup f_name row_map
in case mb_sqlv of
Just v -> fromSql v
Nothing -> error ("Function 'takeFieldValue' failed!\nField '" ++ f_name ++ "' not found.\nRow: " ++ show row_map)
takeUFieldValue :: Convertible SqlValue a => FieldName -> Map FieldName SqlValue -> a
takeUFieldValue f_name row_map = takeFieldValue (map toUpper f_name) row_map
uppercaseMapKeys :: Map String a -> Map String a
uppercaseMapKeys = M.mapKeys (map toUpper)
liftInList :: a -> [a]
liftInList a = a : []