  Copyright ( c ) 2017 Uber Technologies , Inc.
--
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
  in the Software without restriction , including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software , and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
--
-- The above copyright notice and this permission notice shall be included in
  all copies or substantial portions of the Software .
--
  THE SOFTWARE IS PROVIDED " AS IS " , WITHOUT WARRANTY OF ANY KIND , EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  LIABILITY , WHETHER IN AN ACTION OF CONTRACT , TORT OR OTHERWISE , ARISING FROM ,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-- THE SOFTWARE.

# LANGUAGE FlexibleContexts #
{-# LANGUAGE RankNTypes #-}
# LANGUAGE ScopedTypeVariables #

module Database.Sql.Type.Schema where

import Database.Sql.Type.Names
import Database.Sql.Type.TableProps
import Database.Sql.Type.Scope

import Control.Applicative (liftA2, liftA3)
import Control.Monad.Except
import Control.Monad.Writer
import Data.Functor.Identity

import qualified Data.HashMap.Strict as HMS

import Data.Maybe (mapMaybe, maybeToList)

and3 :: Bool -> Bool -> Bool -> Bool
and3 x y z = x && y && z

overWithColumns :: (r a -> s a) -> WithColumns r a -> WithColumns s a
overWithColumns f (WithColumns r cs) = WithColumns (f r) cs


resolvedColumnHasName :: QColumnName f a -> RColumnRef a -> Bool
resolvedColumnHasName (QColumnName _ _ name) (RColumnAlias (ColumnAlias _ name' _)) = name' == name
resolvedColumnHasName (QColumnName _ _ name) (RColumnRef (QColumnName _ _ name')) = name' == name

makeCatalog :: CatalogMap -> Path -> CurrentDatabase -> Catalog
makeCatalog catalog path currentDb = Catalog{..}
  where
    catalogResolveTableNameHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            default' = RTableName fqtn (persistentTable [])
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableNameResolved = Right $ TableNameResolved oqtn default'
        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableNameResolved] >> pure default'
            Just database ->
                case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> tell [missingS, missingT, tableNameResolved] >> pure default'
                    Just schema -> do
                        case HMS.lookup (QTableName () None tableName) schema of
                            Nothing -> tell [missingT, tableNameResolved] >> pure default'
                            Just table -> do
                                let rtn = RTableName fqtn table
                                tell [Right $ TableNameResolved oqtn rtn]
                                pure rtn

    catalogResolveTableNameHelper _ = error "only call catalogResolveTableNameHelper with fully qualified table name"

    catalogResolveTableName oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableNameHelper oqtn

    catalogResolveTableName (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableNameHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableName oqtn@(QTableName tInfo Nothing tableName) = do
        let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                db <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn db
                table <- HMS.lookup (QTableName () None tableName) schema
                let db' = fmap (const tInfo) currentDb
                    fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                    fqtn = QTableName tInfo (pure fqsn) tableName
                pure $ RTableName fqtn table

        case mapMaybe getTableFromSchema path of
            rtn:_ -> do
                tell [Right $ TableNameResolved oqtn rtn]
                pure rtn
            [] -> throwError $ MissingTable oqtn

  TODO session schemas should have the name set to the session ID
    catalogResolveSchemaName :: forall a . OQSchemaName a -> CatalogObjectResolver a (FQSchemaName a)
    catalogResolveSchemaName (QSchemaName sInfo (Just db) schemaName schemaType) =
        pure $ QSchemaName sInfo (pure db) schemaName schemaType
    catalogResolveSchemaName oqsn@(QSchemaName _ Nothing _ _) =
        pure $ inCurrentDb oqsn

    catalogHasDatabase databaseName =
        case HMS.member (void databaseName) catalog of
            False -> DoesNotExist
            True -> Exists

    catalogHasSchema schemaName =
        case HMS.lookup currentDb catalog of
            Just db -> case HMS.member (void schemaName) db of
                False -> DoesNotExist
                True -> Exists
            Nothing -> DoesNotExist

    catalogResolveTableRefHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName

        case HMS.lookup (void db) catalog of
            Nothing -> throwError $ MissingDatabase db
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> throwError $ MissingSchema oqsn
                    Just tables -> do
                        case HMS.lookup (QTableName () None tableName) tables of
                            Nothing -> throwError $ MissingTable oqtn
                            Just table@SchemaMember{..} -> do
                                let makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                                    tableRef = RTableRef fqtn table
                                tell [Right $ TableRefResolved oqtn tableRef]
                                pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

    catalogResolveTableRefHelper _ = error "only call catalogResolveTableRefHelper with fully qualified table name"

    catalogResolveTableRef _ oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableRefHelper oqtn

    catalogResolveTableRef _ (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableRefHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableRef boundCTEs oqtn@(QTableName tInfo Nothing tableName) = do
        case filter (resolvedTableHasName oqtn) $ map (uncurry RTableAlias) boundCTEs of
            [t] -> do
                tell [Right $ TableRefResolved oqtn t]
                pure $ WithColumns t [(Just t, getColumnList t)]
            _:_ -> throwError $ AmbiguousTable oqtn
            [] -> do
                let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                        db <- HMS.lookup currentDb catalog
                        schema <- HMS.lookup uqsn db
                        table@SchemaMember{..} <- HMS.lookup (QTableName () None tableName) schema
                        let db' = fmap (const tInfo) currentDb
                            fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                            fqtn = QTableName tInfo (pure fqsn) tableName
                            makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                            tableRef = RTableRef fqtn table
                        pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

                case mapMaybe getTableFromSchema path of
                    table@(WithColumns tableRef _):_ -> do
                        tell [Right $ TableRefResolved oqtn tableRef]
                        pure table
                    [] -> throwError $ MissingTable oqtn

    catalogResolveCreateSchemaName oqsn = do
        fqsn@(QSchemaName _ (Identity db) schemaName schemaType) <- case schemaNameType oqsn of
            NormalSchema -> catalogResolveSchemaName oqsn
            SessionSchema -> error "can't create the session schema"
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [Left $ MissingDatabase db] >> pure DoesNotExist
            Just database -> if HMS.member (QSchemaName () None schemaName schemaType) database
                then pure Exists
                else pure DoesNotExist
        let rcsn = RCreateSchemaName fqsn existence
        tell [Right $ CreateSchemaNameResolved oqsn rcsn]
        pure rcsn

    catalogResolveCreateTableName name = do
        ~oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schemaName schemaType)) tableName) <-
                case name of
                    oqtn@(QTableName _ Nothing _) -> pure $ inHeadOfPath oqtn
                    QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName -> pure $ QTableName tInfo (pure $ inCurrentDb oqsn) tableName
                    _ -> pure name

        let missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS] >> pure DoesNotExist
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS] >> pure DoesNotExist
                Just schema -> if HMS.member (QTableName () None tableName) schema
                     then pure Exists
                     else pure DoesNotExist

        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            rctn = RCreateTableName (QTableName tInfo (pure fqsn) tableName) existence
        tell [Right $ CreateTableNameResolved oqtn rctn]

        pure rctn

    inCurrentDb :: Applicative g => QSchemaName f a -> QSchemaName g a
    inCurrentDb (QSchemaName sInfo _ schemaName schemaType) =
        let db = fmap (const sInfo) currentDb
         in QSchemaName sInfo (pure db) schemaName schemaType

    inHeadOfPath :: Applicative g => QTableName f a -> QTableName g a
    inHeadOfPath (QTableName tInfo _ tableName) =
        let db = fmap (const tInfo) currentDb
            QSchemaName _ None schemaName schemaType = head path
            qsn = QSchemaName tInfo (pure db) schemaName schemaType
         in QTableName tInfo (pure qsn) tableName

    catalogResolveColumnName :: forall a . [(Maybe (RTableRef a), [RColumnRef a])] -> OQColumnName a -> CatalogObjectResolver a (RColumnRef a)
    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schema schemaType)) table)) column) = do
        case filter (maybe False (liftA3 and3 (resolvedTableHasDatabase db) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> throwError $ UnintroducedTable oqtn
            _:_:_ -> throwError $ AmbiguousTable oqtn
            [(_, columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> do
                        let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure db) schema schemaType) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefResolved oqcn c
                             ]
                        pure c
                    [c] -> do
                        let c' = fmap (const cInfo) c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo Nothing schema schemaType)) table)) column) = do
        case filter (maybe False (liftA2 (&&) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> throwError $ UnintroducedTable oqtn
            _:_:_ -> throwError $ AmbiguousTable oqtn
            [(table', columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> do
                        let Just (RTableRef (QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) _ _)) _) _) = table' -- this pattern match shouldn't fail:
  the ` maybe False ` prevents Nothings , and the ` resolvedTableHasSchema ` prevents 
                            c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure $ DatabaseName sInfo db) schema schemaType) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefResolved oqcn c
                             ]
                        pure c
                    [c] -> do
                        let c' = fmap (const cInfo) c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo Nothing table)) column) = do
        let setInfo :: Functor f => f a -> f a
            setInfo = fmap (const cInfo)

        case [ (t, cs) | (mt, cs) <- boundColumns, t <- maybeToList mt, resolvedTableHasName oqtn t ] of
            [] -> throwError $ UnintroducedTable oqtn
            [(table', columns)] -> do
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> case table' of
                        RTableAlias _ _ -> throwError $ MissingColumn oqcn
                        RTableRef fqtn@(QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) schema schemaType)) _) _ -> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ setInfo fqtn) column
                            tell [ Left $ MissingColumn $ QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName cInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                                 , Right $ ColumnRefResolved oqcn c]
                            pure c
                    [c] -> do
                        let c' = setInfo c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn
            tables -> do
                tell [Left $ AmbiguousTable oqtn]
                case filter (resolvedColumnHasName oqcn) $ snd =<< tables of
                    [] -> throwError $ MissingColumn oqcn
                    [c] -> do
                        let c' = setInfo c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo Nothing _) = do
        let columns = snd =<< boundColumns
        case filter (resolvedColumnHasName oqcn) columns of
            [] -> throwError $ MissingColumn oqcn
            [c] -> do
                let c' = fmap (const cInfo) c
                tell [Right $ ColumnRefResolved oqcn c']
                pure c'
            _ -> throwError $ AmbiguousColumn oqcn

    catalogHasTable tableName =
        let getTableFromSchema uqsn = do
                database <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn database
                pure $ HMS.member tableName schema
         in case any id $ mapMaybe getTableFromSchema path of
            False -> DoesNotExist
            True -> Exists

    overCatalogMap f =
        let (cm, extra) = f catalog
         in seq cm $ (makeCatalog cm path currentDb, extra)

    catalogMap = catalog

    catalogWithPath newPath = makeCatalog catalog newPath currentDb

    catalogWithDatabase = makeCatalog catalog path

defaultSchemaMember :: SchemaMember
defaultSchemaMember = SchemaMember{..}
  where
    tableType = Table
    persistence = Persistent
    columnsList = []
    viewQuery = Nothing

unknownDatabase :: a -> DatabaseName a
unknownDatabase info = DatabaseName info "<unknown>"

unknownSchema :: a -> FQSchemaName a
unknownSchema info = QSchemaName info (pure $ unknownDatabase info) "<unknown>" NormalSchema

unknownTable :: a -> FQTableName a
unknownTable info = QTableName info (pure $ unknownSchema info) "<unknown>"

makeDefaultingCatalog :: CatalogMap -> Path -> CurrentDatabase -> Catalog
makeDefaultingCatalog catalog path currentDb = Catalog{..}
  where
    catalogResolveTableNameHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            default' = RTableName fqtn (persistentTable [])
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableNameResolved = Right $ TableNameResolved oqtn default'
        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableNameResolved] >> pure default'
            Just database ->
                case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> tell [missingS, missingT, tableNameResolved] >> pure default'
                    Just schema -> do
                        case HMS.lookup (QTableName () None tableName) schema of
                            Nothing -> tell [missingT, tableNameResolved] >> pure default'
                            Just table -> do
                                let rtn = RTableName fqtn table
                                tell [Right $ TableNameResolved oqtn rtn]
                                pure rtn

    catalogResolveTableNameHelper _ = error "only call catalogResolveTableNameHelper with fully qualified table name"

    catalogResolveTableName oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableNameHelper oqtn

    catalogResolveTableName (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableNameHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableName oqtn@(QTableName tInfo Nothing tableName) = do
        let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                db <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn db
                table <- HMS.lookup (QTableName () None tableName) schema
                let db' = fmap (const tInfo) currentDb
                    fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                    fqtn = QTableName tInfo (pure fqsn) tableName
                pure $ RTableName fqtn table

        case mapMaybe getTableFromSchema path of
            rtn:_ -> do
                tell [Right $ TableNameResolved oqtn rtn]
                pure rtn
            [] -> do
                let rtn = RTableName (inHeadOfPath oqtn) $ persistentTable []
                tell [ Left $ MissingTable oqtn
                     , Right $ TableNameDefaulted oqtn rtn
                     ]
                pure rtn

    inCurrentDb :: Applicative g => QSchemaName f a -> QSchemaName g a
    inCurrentDb (QSchemaName sInfo _ schemaName schemaType) =
        let db = fmap (const sInfo) currentDb
         in QSchemaName sInfo (pure db) schemaName schemaType

    inHeadOfPath :: Applicative g => QTableName f a -> QTableName g a
    inHeadOfPath (QTableName tInfo _ tableName) =
        let db = fmap (const tInfo) currentDb
            QSchemaName _ None schemaName schemaType = head path
            fqsn = QSchemaName tInfo (pure db) schemaName schemaType
         in QTableName tInfo (pure fqsn) tableName

  TODO session schemas should have the name set to the session ID
    catalogResolveSchemaName :: forall a . OQSchemaName a -> CatalogObjectResolver a (FQSchemaName a)
    catalogResolveSchemaName (QSchemaName sInfo (Just db) schemaName schemaType) =
        pure $ QSchemaName sInfo (pure db) schemaName schemaType
    catalogResolveSchemaName oqsn@(QSchemaName _ Nothing _ _) =
        pure $ inCurrentDb oqsn

    catalogHasDatabase databaseName =
        case HMS.member (void databaseName) catalog of
            False -> DoesNotExist
            True -> Exists

    catalogHasSchema schemaName =
        case HMS.lookup currentDb catalog of
            Just db -> case HMS.member (void schemaName) db of
                False -> DoesNotExist
                True -> Exists
            Nothing -> DoesNotExist

    catalogResolveTableRefHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            defaultTableRef = RTableRef fqtn defaultSchemaMember
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableRefResolved = Right $ TableRefResolved oqtn defaultTableRef
            default' = WithColumns defaultTableRef [(Just defaultTableRef, [])]

        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableRefResolved] >> pure default'
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS, missingT, tableRefResolved] >> pure default'
                Just schema -> do
                    case HMS.lookup (QTableName () None tableName) schema of
                        Nothing -> tell [missingT, tableRefResolved] >> pure default'
                        Just table@SchemaMember{..} -> do
                            let makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                                tableRef = RTableRef fqtn table
                            tell [Right $ TableRefResolved oqtn tableRef]
                            pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

    catalogResolveTableRefHelper _ = error "only call catalogResolveTableRefHelper with fully qualified table name"

    catalogResolveTableRef _ oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableRefHelper oqtn

    catalogResolveTableRef _ (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableRefHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableRef boundCTEs oqtn@(QTableName tInfo Nothing tableName) = do
        case filter (resolvedTableHasName oqtn) $ map (uncurry RTableAlias) boundCTEs of
            (t:rest) -> do
                if null rest
                   then tell [ Right $ TableRefResolved oqtn t ]
                   else tell [ Left $ AmbiguousTable oqtn
                             , Right $ TableRefDefaulted oqtn t
                             ]
                let ts' = map (\(t', cs) -> (Just $ RTableAlias t' cs, cs)) boundCTEs
                pure $ WithColumns t ts'
            [] -> do
                let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                        db <- HMS.lookup currentDb catalog
                        schema <- HMS.lookup uqsn db
                        table@SchemaMember{..} <- HMS.lookup (QTableName () None tableName) schema
                        let db' = fmap (const tInfo) currentDb
                            fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                            fqtn = QTableName tInfo (pure fqsn) tableName
                            makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                            tableRef = RTableRef fqtn table
                        pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

                case mapMaybe getTableFromSchema path of
                    table@(WithColumns tableRef _):_ -> do
                        tell [Right $ TableRefResolved oqtn tableRef]
                        pure table
                    [] -> do
                        let tableRef = RTableRef (inHeadOfPath oqtn) defaultSchemaMember
                        tell [ Left $ MissingTable oqtn
                             , Right $ TableRefDefaulted oqtn tableRef
                             ]
                        -- TODO: deal with columns
                        pure $ WithColumns tableRef [(Just tableRef, [])]

    catalogResolveCreateSchemaName oqsn = do
        fqsn@(QSchemaName _ (Identity db) schemaName schemaType) <- case schemaNameType oqsn of
            NormalSchema -> catalogResolveSchemaName oqsn
            SessionSchema -> error "can't create the session schema"
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [Left $ MissingDatabase db] >> pure DoesNotExist
            Just database -> if HMS.member (QSchemaName () None schemaName schemaType) database
                then pure Exists
                else pure DoesNotExist
        let rcsn = RCreateSchemaName fqsn existence
        tell [Right $ CreateSchemaNameResolved oqsn rcsn]
        pure rcsn

    catalogResolveCreateTableName name = do
        ~oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schemaName schemaType)) tableName) <-
                case name of
                    oqtn@(QTableName _ Nothing _) -> pure $ inHeadOfPath oqtn
                    (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) -> pure $ QTableName tInfo (pure $ inCurrentDb oqsn) tableName
                    _ -> pure name

        let missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS] >> pure DoesNotExist
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS] >> pure DoesNotExist
                Just schema -> if HMS.member (QTableName () None tableName) schema
                     then pure Exists
                     else pure DoesNotExist

        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            rctn = RCreateTableName (QTableName tInfo (pure fqsn) tableName) existence
        tell [Right $ CreateTableNameResolved oqtn rctn]

        pure rctn

    catalogResolveColumnName :: forall a . [(Maybe (RTableRef a), [RColumnRef a])] -> OQColumnName a -> CatalogObjectResolver a (RColumnRef a)
    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schema schemaType)) table)) column) = do
        case filter (maybe False (liftA3 and3 (resolvedTableHasDatabase db) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> tell [Left $ UnintroducedTable oqtn]
            _:_:_ -> tell [Left $ AmbiguousTable oqtn]
            [(_, columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> tell [Left $ MissingColumn oqcn]
                    [_] -> pure ()
                    _ -> tell [Left $ AmbiguousColumn oqcn]
        let columnRef = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure db) schema schemaType) table) column
        tell [Right $ ColumnRefResolved oqcn columnRef]
        pure columnRef

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo Nothing schema schemaType)) table)) column) = do
        let filtered = filter (maybe False (liftA2 (&&) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns
            fqtnDefault = QTableName tInfo (Identity $ inCurrentDb oqsn) table
        fqtn <- case filtered of
            [] -> tell [Left $ UnintroducedTable oqtn] >> pure fqtnDefault
            _:_:_ -> tell [Left $ AmbiguousTable oqtn] >> pure fqtnDefault
            [(table', columns)] -> do
                let Just (RTableRef (QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) _ _)) _) _) = table' -- this pattern match shouldn't fail:
  the ` maybe False ` prevents Nothings , and the ` resolvedTableHasSchema ` prevents 
                    oqcnKnownDb = QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName sInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                    fqtnKnownDb = QTableName tInfo (Identity $ QSchemaName sInfo (Identity $ DatabaseName cInfo db) schema schemaType) table
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> tell [Left $ MissingColumn oqcnKnownDb] >> pure fqtnKnownDb
                    [_] -> pure fqtnKnownDb
                    _ -> tell [Left $ AmbiguousColumn oqcnKnownDb] >> pure fqtnKnownDb

        let columnRef = RColumnRef $ QColumnName cInfo (pure fqtn) column
        tell [Right $ ColumnRefResolved oqcn columnRef]
        pure columnRef

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo Nothing table)) column) = do
        let setInfo :: Functor f => f a -> f a
            setInfo = fmap (const cInfo)

        case [ (t, cs) | (mt, cs) <- boundColumns, t <- maybeToList mt, resolvedTableHasName oqtn t ] of
            [] -> do
                let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                tell [ Left $ UnintroducedTable oqtn
                     , Right $ ColumnRefDefaulted oqcn c
                     ]
                pure c
            [(table', columns)] -> do
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> case table' of
                        RTableAlias _ _-> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                            tell [ Left $ MissingColumn oqcn
                                 , Right $ ColumnRefDefaulted oqcn c
                                 ]
                            pure c
                        RTableRef fqtn@(QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) schema schemaType)) _) _ -> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ setInfo fqtn) column
                            tell [ Left $ MissingColumn $ QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName cInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                                 , Right $ ColumnRefResolved oqcn c]
                            pure c
                    c:rest -> do
                        let c' = setInfo c
                        if (null rest)
                            then tell [Right $ ColumnRefResolved oqcn c']
                            else tell [ Left $ AmbiguousColumn oqcn
                                      , Right $ ColumnRefDefaulted oqcn c'
                                      ]
                        pure c'
            tables -> do
                tell [Left $ AmbiguousTable oqtn]
                case filter (resolvedColumnHasName oqcn) $ snd =<< tables of
                    [] -> do
                        let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefDefaulted oqcn c
                             ]
                        pure c
                    c:rest -> do
                        let c' = setInfo c
                        if (null rest)
                            then tell [Right $ ColumnRefResolved oqcn c']
                            else tell [ Left $ AmbiguousColumn oqcn
                                      , Right $ ColumnRefDefaulted oqcn c'
                                      ]
                        pure c'

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo Nothing column) = do
        let columns = snd =<< boundColumns
        case filter (resolvedColumnHasName oqcn) columns of
            [] -> do
                let table =
                        case boundColumns of
                            [(Just (RTableRef t _), _)] -> t
                            _ -> unknownTable cInfo
                    c = RColumnRef $ QColumnName cInfo (pure table) column
                tell [ Left $ MissingColumn oqcn
                     , Right $ ColumnRefDefaulted oqcn c
                     ]
                pure c
            c:rest -> do
                let c' = fmap (const cInfo) c
                if (null rest)
                    then tell [ Right $ ColumnRefResolved oqcn c' ]
                    else tell [ Left $ AmbiguousColumn oqcn
                              , Right $ ColumnRefDefaulted oqcn c'
                              ]
                pure c'

    catalogHasTable tableName =
        let getTableFromSchema uqsn = do
                database <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn database
                pure $ HMS.member tableName schema
         in case any id $ mapMaybe getTableFromSchema path of
            False -> DoesNotExist
            True -> Exists

    overCatalogMap f =
        let (cm, extra) = f catalog
         in seq cm $ (makeDefaultingCatalog cm path currentDb, extra)

    catalogMap = catalog

    catalogWithPath newPath = makeDefaultingCatalog catalog newPath currentDb

    catalogWithDatabase = makeDefaultingCatalog catalog path


 Permission is hereby granted, free of charge, to any person obtaining a copy
 of this software and associated documentation files (the "Software"), to deal
 to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 furnished to do so, subject to the following conditions:

 The above copyright notice and this permission notice shall be included in

 IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
 THE SOFTWARE.
# LANGUAGE RankNTypes #
 this pattern match shouldn't fail:
 TODO: deal with columns
 this pattern match shouldn't fail:
  Copyright ( c ) 2017 Uber Technologies , Inc.
  in the Software without restriction , including without limitation the rights
  copies of the Software , and to permit persons to whom the Software is
  all copies or substantial portions of the Software .
  THE SOFTWARE IS PROVIDED " AS IS " , WITHOUT WARRANTY OF ANY KIND , EXPRESS OR
  LIABILITY , WHETHER IN AN ACTION OF CONTRACT , TORT OR OTHERWISE , ARISING FROM ,

# LANGUAGE FlexibleContexts #
# LANGUAGE ScopedTypeVariables #

module Database.Sql.Type.Schema where

import Database.Sql.Type.Names
import Database.Sql.Type.TableProps
import Database.Sql.Type.Scope

import Control.Applicative (liftA2, liftA3)
import Control.Monad.Except
import Control.Monad.Writer
import Data.Functor.Identity

import qualified Data.HashMap.Strict as HMS

import Data.Maybe (mapMaybe, maybeToList)

and3 :: Bool -> Bool -> Bool -> Bool
and3 x y z = x && y && z

overWithColumns :: (r a -> s a) -> WithColumns r a -> WithColumns s a
overWithColumns f (WithColumns r cs) = WithColumns (f r) cs


resolvedColumnHasName :: QColumnName f a -> RColumnRef a -> Bool
resolvedColumnHasName (QColumnName _ _ name) (RColumnAlias (ColumnAlias _ name' _)) = name' == name
resolvedColumnHasName (QColumnName _ _ name) (RColumnRef (QColumnName _ _ name')) = name' == name

makeCatalog :: CatalogMap -> Path -> CurrentDatabase -> Catalog
makeCatalog catalog path currentDb = Catalog{..}
  where
    catalogResolveTableNameHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            default' = RTableName fqtn (persistentTable [])
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableNameResolved = Right $ TableNameResolved oqtn default'
        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableNameResolved] >> pure default'
            Just database ->
                case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> tell [missingS, missingT, tableNameResolved] >> pure default'
                    Just schema -> do
                        case HMS.lookup (QTableName () None tableName) schema of
                            Nothing -> tell [missingT, tableNameResolved] >> pure default'
                            Just table -> do
                                let rtn = RTableName fqtn table
                                tell [Right $ TableNameResolved oqtn rtn]
                                pure rtn

    catalogResolveTableNameHelper _ = error "only call catalogResolveTableNameHelper with fully qualified table name"

    catalogResolveTableName oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableNameHelper oqtn

    catalogResolveTableName (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableNameHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableName oqtn@(QTableName tInfo Nothing tableName) = do
        let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                db <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn db
                table <- HMS.lookup (QTableName () None tableName) schema
                let db' = fmap (const tInfo) currentDb
                    fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                    fqtn = QTableName tInfo (pure fqsn) tableName
                pure $ RTableName fqtn table

        case mapMaybe getTableFromSchema path of
            rtn:_ -> do
                tell [Right $ TableNameResolved oqtn rtn]
                pure rtn
            [] -> throwError $ MissingTable oqtn

  TODO session schemas should have the name set to the session ID
    catalogResolveSchemaName :: forall a . OQSchemaName a -> CatalogObjectResolver a (FQSchemaName a)
    catalogResolveSchemaName (QSchemaName sInfo (Just db) schemaName schemaType) =
        pure $ QSchemaName sInfo (pure db) schemaName schemaType
    catalogResolveSchemaName oqsn@(QSchemaName _ Nothing _ _) =
        pure $ inCurrentDb oqsn

    catalogHasDatabase databaseName =
        case HMS.member (void databaseName) catalog of
            False -> DoesNotExist
            True -> Exists

    catalogHasSchema schemaName =
        case HMS.lookup currentDb catalog of
            Just db -> case HMS.member (void schemaName) db of
                False -> DoesNotExist
                True -> Exists
            Nothing -> DoesNotExist

    catalogResolveTableRefHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName

        case HMS.lookup (void db) catalog of
            Nothing -> throwError $ MissingDatabase db
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> throwError $ MissingSchema oqsn
                    Just tables -> do
                        case HMS.lookup (QTableName () None tableName) tables of
                            Nothing -> throwError $ MissingTable oqtn
                            Just table@SchemaMember{..} -> do
                                let makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                                    tableRef = RTableRef fqtn table
                                tell [Right $ TableRefResolved oqtn tableRef]
                                pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

    catalogResolveTableRefHelper _ = error "only call catalogResolveTableRefHelper with fully qualified table name"

    catalogResolveTableRef _ oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableRefHelper oqtn

    catalogResolveTableRef _ (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableRefHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableRef boundCTEs oqtn@(QTableName tInfo Nothing tableName) = do
        case filter (resolvedTableHasName oqtn) $ map (uncurry RTableAlias) boundCTEs of
            [t] -> do
                tell [Right $ TableRefResolved oqtn t]
                pure $ WithColumns t [(Just t, getColumnList t)]
            _:_ -> throwError $ AmbiguousTable oqtn
            [] -> do
                let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                        db <- HMS.lookup currentDb catalog
                        schema <- HMS.lookup uqsn db
                        table@SchemaMember{..} <- HMS.lookup (QTableName () None tableName) schema
                        let db' = fmap (const tInfo) currentDb
                            fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                            fqtn = QTableName tInfo (pure fqsn) tableName
                            makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                            tableRef = RTableRef fqtn table
                        pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

                case mapMaybe getTableFromSchema path of
                    table@(WithColumns tableRef _):_ -> do
                        tell [Right $ TableRefResolved oqtn tableRef]
                        pure table
                    [] -> throwError $ MissingTable oqtn

    catalogResolveCreateSchemaName oqsn = do
        fqsn@(QSchemaName _ (Identity db) schemaName schemaType) <- case schemaNameType oqsn of
            NormalSchema -> catalogResolveSchemaName oqsn
            SessionSchema -> error "can't create the session schema"
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [Left $ MissingDatabase db] >> pure DoesNotExist
            Just database -> if HMS.member (QSchemaName () None schemaName schemaType) database
                then pure Exists
                else pure DoesNotExist
        let rcsn = RCreateSchemaName fqsn existence
        tell [Right $ CreateSchemaNameResolved oqsn rcsn]
        pure rcsn

    catalogResolveCreateTableName name = do
        ~oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schemaName schemaType)) tableName) <-
                case name of
                    oqtn@(QTableName _ Nothing _) -> pure $ inHeadOfPath oqtn
                    QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName -> pure $ QTableName tInfo (pure $ inCurrentDb oqsn) tableName
                    _ -> pure name

        let missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS] >> pure DoesNotExist
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS] >> pure DoesNotExist
                Just schema -> if HMS.member (QTableName () None tableName) schema
                     then pure Exists
                     else pure DoesNotExist

        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            rctn = RCreateTableName (QTableName tInfo (pure fqsn) tableName) existence
        tell [Right $ CreateTableNameResolved oqtn rctn]

        pure rctn

    inCurrentDb :: Applicative g => QSchemaName f a -> QSchemaName g a
    inCurrentDb (QSchemaName sInfo _ schemaName schemaType) =
        let db = fmap (const sInfo) currentDb
         in QSchemaName sInfo (pure db) schemaName schemaType

    inHeadOfPath :: Applicative g => QTableName f a -> QTableName g a
    inHeadOfPath (QTableName tInfo _ tableName) =
        let db = fmap (const tInfo) currentDb
            QSchemaName _ None schemaName schemaType = head path
            qsn = QSchemaName tInfo (pure db) schemaName schemaType
         in QTableName tInfo (pure qsn) tableName

    catalogResolveColumnName :: forall a . [(Maybe (RTableRef a), [RColumnRef a])] -> OQColumnName a -> CatalogObjectResolver a (RColumnRef a)
    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schema schemaType)) table)) column) = do
        case filter (maybe False (liftA3 and3 (resolvedTableHasDatabase db) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> throwError $ UnintroducedTable oqtn
            _:_:_ -> throwError $ AmbiguousTable oqtn
            [(_, columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> do
                        let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure db) schema schemaType) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefResolved oqcn c
                             ]
                        pure c
                    [c] -> do
                        let c' = fmap (const cInfo) c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo Nothing schema schemaType)) table)) column) = do
        case filter (maybe False (liftA2 (&&) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> throwError $ UnintroducedTable oqtn
            _:_:_ -> throwError $ AmbiguousTable oqtn
            [(table', columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> do
  the ` maybe False ` prevents Nothings , and the ` resolvedTableHasSchema ` prevents 
                            c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure $ DatabaseName sInfo db) schema schemaType) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefResolved oqcn c
                             ]
                        pure c
                    [c] -> do
                        let c' = fmap (const cInfo) c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo Nothing table)) column) = do
        let setInfo :: Functor f => f a -> f a
            setInfo = fmap (const cInfo)

        case [ (t, cs) | (mt, cs) <- boundColumns, t <- maybeToList mt, resolvedTableHasName oqtn t ] of
            [] -> throwError $ UnintroducedTable oqtn
            [(table', columns)] -> do
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> case table' of
                        RTableAlias _ _ -> throwError $ MissingColumn oqcn
                        RTableRef fqtn@(QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) schema schemaType)) _) _ -> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ setInfo fqtn) column
                            tell [ Left $ MissingColumn $ QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName cInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                                 , Right $ ColumnRefResolved oqcn c]
                            pure c
                    [c] -> do
                        let c' = setInfo c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn
            tables -> do
                tell [Left $ AmbiguousTable oqtn]
                case filter (resolvedColumnHasName oqcn) $ snd =<< tables of
                    [] -> throwError $ MissingColumn oqcn
                    [c] -> do
                        let c' = setInfo c
                        tell [Right $ ColumnRefResolved oqcn c']
                        pure c'
                    _ -> throwError $ AmbiguousColumn oqcn

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo Nothing _) = do
        let columns = snd =<< boundColumns
        case filter (resolvedColumnHasName oqcn) columns of
            [] -> throwError $ MissingColumn oqcn
            [c] -> do
                let c' = fmap (const cInfo) c
                tell [Right $ ColumnRefResolved oqcn c']
                pure c'
            _ -> throwError $ AmbiguousColumn oqcn

    catalogHasTable tableName =
        let getTableFromSchema uqsn = do
                database <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn database
                pure $ HMS.member tableName schema
         in case any id $ mapMaybe getTableFromSchema path of
            False -> DoesNotExist
            True -> Exists

    overCatalogMap f =
        let (cm, extra) = f catalog
         in seq cm $ (makeCatalog cm path currentDb, extra)

    catalogMap = catalog

    catalogWithPath newPath = makeCatalog catalog newPath currentDb

    catalogWithDatabase = makeCatalog catalog path

defaultSchemaMember :: SchemaMember
defaultSchemaMember = SchemaMember{..}
  where
    tableType = Table
    persistence = Persistent
    columnsList = []
    viewQuery = Nothing

unknownDatabase :: a -> DatabaseName a
unknownDatabase info = DatabaseName info "<unknown>"

unknownSchema :: a -> FQSchemaName a
unknownSchema info = QSchemaName info (pure $ unknownDatabase info) "<unknown>" NormalSchema

unknownTable :: a -> FQTableName a
unknownTable info = QTableName info (pure $ unknownSchema info) "<unknown>"

makeDefaultingCatalog :: CatalogMap -> Path -> CurrentDatabase -> Catalog
makeDefaultingCatalog catalog path currentDb = Catalog{..}
  where
    catalogResolveTableNameHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            default' = RTableName fqtn (persistentTable [])
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableNameResolved = Right $ TableNameResolved oqtn default'
        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableNameResolved] >> pure default'
            Just database ->
                case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                    Nothing -> tell [missingS, missingT, tableNameResolved] >> pure default'
                    Just schema -> do
                        case HMS.lookup (QTableName () None tableName) schema of
                            Nothing -> tell [missingT, tableNameResolved] >> pure default'
                            Just table -> do
                                let rtn = RTableName fqtn table
                                tell [Right $ TableNameResolved oqtn rtn]
                                pure rtn

    catalogResolveTableNameHelper _ = error "only call catalogResolveTableNameHelper with fully qualified table name"

    catalogResolveTableName oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableNameHelper oqtn

    catalogResolveTableName (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableNameHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableName oqtn@(QTableName tInfo Nothing tableName) = do
        let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                db <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn db
                table <- HMS.lookup (QTableName () None tableName) schema
                let db' = fmap (const tInfo) currentDb
                    fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                    fqtn = QTableName tInfo (pure fqsn) tableName
                pure $ RTableName fqtn table

        case mapMaybe getTableFromSchema path of
            rtn:_ -> do
                tell [Right $ TableNameResolved oqtn rtn]
                pure rtn
            [] -> do
                let rtn = RTableName (inHeadOfPath oqtn) $ persistentTable []
                tell [ Left $ MissingTable oqtn
                     , Right $ TableNameDefaulted oqtn rtn
                     ]
                pure rtn

    inCurrentDb :: Applicative g => QSchemaName f a -> QSchemaName g a
    inCurrentDb (QSchemaName sInfo _ schemaName schemaType) =
        let db = fmap (const sInfo) currentDb
         in QSchemaName sInfo (pure db) schemaName schemaType

    inHeadOfPath :: Applicative g => QTableName f a -> QTableName g a
    inHeadOfPath (QTableName tInfo _ tableName) =
        let db = fmap (const tInfo) currentDb
            QSchemaName _ None schemaName schemaType = head path
            fqsn = QSchemaName tInfo (pure db) schemaName schemaType
         in QTableName tInfo (pure fqsn) tableName

  TODO session schemas should have the name set to the session ID
    catalogResolveSchemaName :: forall a . OQSchemaName a -> CatalogObjectResolver a (FQSchemaName a)
    catalogResolveSchemaName (QSchemaName sInfo (Just db) schemaName schemaType) =
        pure $ QSchemaName sInfo (pure db) schemaName schemaType
    catalogResolveSchemaName oqsn@(QSchemaName _ Nothing _ _) =
        pure $ inCurrentDb oqsn

    catalogHasDatabase databaseName =
        case HMS.member (void databaseName) catalog of
            False -> DoesNotExist
            True -> Exists

    catalogHasSchema schemaName =
        case HMS.lookup currentDb catalog of
            Just db -> case HMS.member (void schemaName) db of
                False -> DoesNotExist
                True -> Exists
            Nothing -> DoesNotExist

    catalogResolveTableRefHelper oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db@(DatabaseName _ _)) schemaName schemaType)) tableName) = do
        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            fqtn = QTableName tInfo (pure fqsn) tableName
            defaultTableRef = RTableRef fqtn defaultSchemaMember
            missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
            missingT = Left $ MissingTable oqtn
            tableRefResolved = Right $ TableRefResolved oqtn defaultTableRef
            default' = WithColumns defaultTableRef [(Just defaultTableRef, [])]

        case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS, missingT, tableRefResolved] >> pure default'
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS, missingT, tableRefResolved] >> pure default'
                Just schema -> do
                    case HMS.lookup (QTableName () None tableName) schema of
                        Nothing -> tell [missingT, tableRefResolved] >> pure default'
                        Just table@SchemaMember{..} -> do
                            let makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                                tableRef = RTableRef fqtn table
                            tell [Right $ TableRefResolved oqtn tableRef]
                            pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

    catalogResolveTableRefHelper _ = error "only call catalogResolveTableRefHelper with fully qualified table name"

    catalogResolveTableRef _ oqtn@(QTableName _ (Just (QSchemaName _ (Just (DatabaseName _ _)) _ _)) _) =
        catalogResolveTableRefHelper oqtn

    catalogResolveTableRef _ (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) =
        catalogResolveTableRefHelper $ QTableName tInfo (Just $ inCurrentDb oqsn) tableName

    catalogResolveTableRef boundCTEs oqtn@(QTableName tInfo Nothing tableName) = do
        case filter (resolvedTableHasName oqtn) $ map (uncurry RTableAlias) boundCTEs of
            (t:rest) -> do
                if null rest
                   then tell [ Right $ TableRefResolved oqtn t ]
                   else tell [ Left $ AmbiguousTable oqtn
                             , Right $ TableRefDefaulted oqtn t
                             ]
                let ts' = map (\(t', cs) -> (Just $ RTableAlias t' cs, cs)) boundCTEs
                pure $ WithColumns t ts'
            [] -> do
                let getTableFromSchema uqsn@(QSchemaName _ None schemaName schemaType) = do
                        db <- HMS.lookup currentDb catalog
                        schema <- HMS.lookup uqsn db
                        table@SchemaMember{..} <- HMS.lookup (QTableName () None tableName) schema
                        let db' = fmap (const tInfo) currentDb
                            fqsn = QSchemaName tInfo (pure db') schemaName schemaType
                            fqtn = QTableName tInfo (pure fqsn) tableName
                            makeRColumnRef (QColumnName () None name) = RColumnRef $ QColumnName tInfo (pure fqtn) name
                            tableRef = RTableRef fqtn table
                        pure $ WithColumns tableRef [(Just tableRef, map makeRColumnRef columnsList)]

                case mapMaybe getTableFromSchema path of
                    table@(WithColumns tableRef _):_ -> do
                        tell [Right $ TableRefResolved oqtn tableRef]
                        pure table
                    [] -> do
                        let tableRef = RTableRef (inHeadOfPath oqtn) defaultSchemaMember
                        tell [ Left $ MissingTable oqtn
                             , Right $ TableRefDefaulted oqtn tableRef
                             ]
                        pure $ WithColumns tableRef [(Just tableRef, [])]

    catalogResolveCreateSchemaName oqsn = do
        fqsn@(QSchemaName _ (Identity db) schemaName schemaType) <- case schemaNameType oqsn of
            NormalSchema -> catalogResolveSchemaName oqsn
            SessionSchema -> error "can't create the session schema"
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [Left $ MissingDatabase db] >> pure DoesNotExist
            Just database -> if HMS.member (QSchemaName () None schemaName schemaType) database
                then pure Exists
                else pure DoesNotExist
        let rcsn = RCreateSchemaName fqsn existence
        tell [Right $ CreateSchemaNameResolved oqsn rcsn]
        pure rcsn

    catalogResolveCreateTableName name = do
        ~oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schemaName schemaType)) tableName) <-
                case name of
                    oqtn@(QTableName _ Nothing _) -> pure $ inHeadOfPath oqtn
                    (QTableName tInfo (Just oqsn@(QSchemaName _ Nothing _ _)) tableName) -> pure $ QTableName tInfo (pure $ inCurrentDb oqsn) tableName
                    _ -> pure name

        let missingD = Left $ MissingDatabase db
            missingS = Left $ MissingSchema oqsn
        existence <- case HMS.lookup (void db) catalog of
            Nothing -> tell [missingD, missingS] >> pure DoesNotExist
            Just database -> case HMS.lookup (QSchemaName () None schemaName schemaType) database of
                Nothing -> tell [missingS] >> pure DoesNotExist
                Just schema -> if HMS.member (QTableName () None tableName) schema
                     then pure Exists
                     else pure DoesNotExist

        let fqsn = QSchemaName sInfo (pure db) schemaName schemaType
            rctn = RCreateTableName (QTableName tInfo (pure fqsn) tableName) existence
        tell [Right $ CreateTableNameResolved oqtn rctn]

        pure rctn

    catalogResolveColumnName :: forall a . [(Maybe (RTableRef a), [RColumnRef a])] -> OQColumnName a -> CatalogObjectResolver a (RColumnRef a)
    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo (Just db) schema schemaType)) table)) column) = do
        case filter (maybe False (liftA3 and3 (resolvedTableHasDatabase db) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns of
            [] -> tell [Left $ UnintroducedTable oqtn]
            _:_:_ -> tell [Left $ AmbiguousTable oqtn]
            [(_, columns)] ->
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> tell [Left $ MissingColumn oqcn]
                    [_] -> pure ()
                    _ -> tell [Left $ AmbiguousColumn oqcn]
        let columnRef = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ QSchemaName sInfo (pure db) schema schemaType) table) column
        tell [Right $ ColumnRefResolved oqcn columnRef]
        pure columnRef

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo (Just oqsn@(QSchemaName sInfo Nothing schema schemaType)) table)) column) = do
        let filtered = filter (maybe False (liftA2 (&&) (resolvedTableHasSchema oqsn) (resolvedTableHasName oqtn)) . fst) boundColumns
            fqtnDefault = QTableName tInfo (Identity $ inCurrentDb oqsn) table
        fqtn <- case filtered of
            [] -> tell [Left $ UnintroducedTable oqtn] >> pure fqtnDefault
            _:_:_ -> tell [Left $ AmbiguousTable oqtn] >> pure fqtnDefault
            [(table', columns)] -> do
  the ` maybe False ` prevents Nothings , and the ` resolvedTableHasSchema ` prevents 
                    oqcnKnownDb = QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName sInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                    fqtnKnownDb = QTableName tInfo (Identity $ QSchemaName sInfo (Identity $ DatabaseName cInfo db) schema schemaType) table
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> tell [Left $ MissingColumn oqcnKnownDb] >> pure fqtnKnownDb
                    [_] -> pure fqtnKnownDb
                    _ -> tell [Left $ AmbiguousColumn oqcnKnownDb] >> pure fqtnKnownDb

        let columnRef = RColumnRef $ QColumnName cInfo (pure fqtn) column
        tell [Right $ ColumnRefResolved oqcn columnRef]
        pure columnRef

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo (Just oqtn@(QTableName tInfo Nothing table)) column) = do
        let setInfo :: Functor f => f a -> f a
            setInfo = fmap (const cInfo)

        case [ (t, cs) | (mt, cs) <- boundColumns, t <- maybeToList mt, resolvedTableHasName oqtn t ] of
            [] -> do
                let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                tell [ Left $ UnintroducedTable oqtn
                     , Right $ ColumnRefDefaulted oqcn c
                     ]
                pure c
            [(table', columns)] -> do
                case filter (resolvedColumnHasName oqcn) columns of
                    [] -> case table' of
                        RTableAlias _ _-> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                            tell [ Left $ MissingColumn oqcn
                                 , Right $ ColumnRefDefaulted oqcn c
                                 ]
                            pure c
                        RTableRef fqtn@(QTableName _ (Identity (QSchemaName _ (Identity (DatabaseName _ db)) schema schemaType)) _) _ -> do
                            let c = RColumnRef $ QColumnName cInfo (pure $ setInfo fqtn) column
                            tell [ Left $ MissingColumn $ QColumnName cInfo (Just $ QTableName tInfo (Just $ QSchemaName cInfo (Just $ DatabaseName cInfo db) schema schemaType) table) column
                                 , Right $ ColumnRefResolved oqcn c]
                            pure c
                    c:rest -> do
                        let c' = setInfo c
                        if (null rest)
                            then tell [Right $ ColumnRefResolved oqcn c']
                            else tell [ Left $ AmbiguousColumn oqcn
                                      , Right $ ColumnRefDefaulted oqcn c'
                                      ]
                        pure c'
            tables -> do
                tell [Left $ AmbiguousTable oqtn]
                case filter (resolvedColumnHasName oqcn) $ snd =<< tables of
                    [] -> do
                        let c = RColumnRef $ QColumnName cInfo (pure $ QTableName tInfo (pure $ unknownSchema tInfo) table) column
                        tell [ Left $ MissingColumn oqcn
                             , Right $ ColumnRefDefaulted oqcn c
                             ]
                        pure c
                    c:rest -> do
                        let c' = setInfo c
                        if (null rest)
                            then tell [Right $ ColumnRefResolved oqcn c']
                            else tell [ Left $ AmbiguousColumn oqcn
                                      , Right $ ColumnRefDefaulted oqcn c'
                                      ]
                        pure c'

    catalogResolveColumnName boundColumns oqcn@(QColumnName cInfo Nothing column) = do
        let columns = snd =<< boundColumns
        case filter (resolvedColumnHasName oqcn) columns of
            [] -> do
                let table =
                        case boundColumns of
                            [(Just (RTableRef t _), _)] -> t
                            _ -> unknownTable cInfo
                    c = RColumnRef $ QColumnName cInfo (pure table) column
                tell [ Left $ MissingColumn oqcn
                     , Right $ ColumnRefDefaulted oqcn c
                     ]
                pure c
            c:rest -> do
                let c' = fmap (const cInfo) c
                if (null rest)
                    then tell [ Right $ ColumnRefResolved oqcn c' ]
                    else tell [ Left $ AmbiguousColumn oqcn
                              , Right $ ColumnRefDefaulted oqcn c'
                              ]
                pure c'

    catalogHasTable tableName =
        let getTableFromSchema uqsn = do
                database <- HMS.lookup currentDb catalog
                schema <- HMS.lookup uqsn database
                pure $ HMS.member tableName schema
         in case any id $ mapMaybe getTableFromSchema path of
            False -> DoesNotExist
            True -> Exists

    overCatalogMap f =
        let (cm, extra) = f catalog
         in seq cm $ (makeDefaultingCatalog cm path currentDb, extra)

    catalogMap = catalog

    catalogWithPath newPath = makeDefaultingCatalog catalog newPath currentDb

    catalogWithDatabase = makeDefaultingCatalog catalog path
