{-# LANGUAGE MagicHash #-}
-- | The database's schema, read from its catalog views: every user table
-- and view with its columns, their declared types ('SqlType'), the
-- primary key, the unique constraints and the foreign keys.
--
-- > tables <- readTablesIn conn "dbo"
-- > forM_ tables $ \t -> forM_ (tableColumns t) $ \c ->
-- >   putStrLn (T.unpack (objectName (tableName t) <> "." <> colName c <> ": " <> maybe (colTypeName c) sqlTypeName (colType c)))
--
-- Everything comes from @sys.objects@, @sys.columns@, @sys.types@ and the
-- constraint views, in one request.  A column's type is resolved through
-- an alias type (@dbo.phone@, based on @varchar(20)@, is a
-- @varchar(20)@; @sysname@ is @nvarchar(128)@), and a CLR user-defined type
-- or a type newer than this library leaves 'colType' 'Nothing' with the
-- name in 'colTypeName'.
--
-- What is not read: indexes, check constraints, triggers, the referential
-- actions of foreign keys, identity seeds, procedures and functions.
module Hmssql.Catalog
  ( -- * Tables and views
    ObjectName (..)
  , objectNameSql
  , Table (..)
  , TableKind (..)
  , Column (..)
  , Computed (..)
  , GeneratedAlways (..)
  , KeyConstraint (..)
  , ForeignKey (..)

    -- * Reading the catalog
  , readTables
  , readTablesIn
  , readTable
  , lookupColumn
  ) where

import Data.List (find, groupBy)
import Data.Function (on)
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)

import Hmssql.Connection (Connection)
import Hmssql.Decoding (FromSqlRow)
import Hmssql.Internal.Derived
import Hmssql.Query (mkQuery, queryResultSets, resultSet)
import Hmssql.SqlType

-- | A schema-qualified name: @dbo.customer@.
data ObjectName = ObjectName
  { ObjectName -> Text
objectSchema :: !Text
  , ObjectName -> Text
objectName :: !Text
  }
  deriving stock (Eq ObjectName
Eq ObjectName =>
(ObjectName -> ObjectName -> Ordering)
-> (ObjectName -> ObjectName -> Bool)
-> (ObjectName -> ObjectName -> Bool)
-> (ObjectName -> ObjectName -> Bool)
-> (ObjectName -> ObjectName -> Bool)
-> (ObjectName -> ObjectName -> ObjectName)
-> (ObjectName -> ObjectName -> ObjectName)
-> Ord ObjectName
ObjectName -> ObjectName -> Bool
ObjectName -> ObjectName -> Ordering
ObjectName -> ObjectName -> ObjectName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectName -> ObjectName -> Ordering
compare :: ObjectName -> ObjectName -> Ordering
$c< :: ObjectName -> ObjectName -> Bool
< :: ObjectName -> ObjectName -> Bool
$c<= :: ObjectName -> ObjectName -> Bool
<= :: ObjectName -> ObjectName -> Bool
$c> :: ObjectName -> ObjectName -> Bool
> :: ObjectName -> ObjectName -> Bool
$c>= :: ObjectName -> ObjectName -> Bool
>= :: ObjectName -> ObjectName -> Bool
$cmax :: ObjectName -> ObjectName -> ObjectName
max :: ObjectName -> ObjectName -> ObjectName
$cmin :: ObjectName -> ObjectName -> ObjectName
min :: ObjectName -> ObjectName -> ObjectName
Ord)

instance Show ObjectName where
  showsPrec :: Int -> ObjectName -> ShowS
showsPrec Int
p (ObjectName Text
a Text
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ObjectName"# [Addr#
"objectSchema"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"objectName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
b]
  {-# OPAQUE showsPrec #-}

instance Eq ObjectName where
  ObjectName Text
a Text
b == :: ObjectName -> ObjectName -> Bool
== ObjectName Text
a' Text
b' = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
b Text
b'
  {-# OPAQUE (==) #-}

-- | The name as SQL, bracket-quoted: @[dbo].[customer]@.
objectNameSql :: ObjectName -> Text
objectNameSql :: ObjectName -> Text
objectNameSql (ObjectName Text
schema Text
name) = Text -> Text
quote Text
schema Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quote Text
name

quote :: Text -> Text
quote :: Text -> Text
quote Text
n = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"]" Text
"]]" Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"

-- | Whether an object is a table or a view.
data TableKind = UserTable | View
  deriving stock (TableKind -> TableKind -> Bool
(TableKind -> TableKind -> Bool)
-> (TableKind -> TableKind -> Bool) -> Eq TableKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableKind -> TableKind -> Bool
== :: TableKind -> TableKind -> Bool
$c/= :: TableKind -> TableKind -> Bool
/= :: TableKind -> TableKind -> Bool
Eq, Eq TableKind
Eq TableKind =>
(TableKind -> TableKind -> Ordering)
-> (TableKind -> TableKind -> Bool)
-> (TableKind -> TableKind -> Bool)
-> (TableKind -> TableKind -> Bool)
-> (TableKind -> TableKind -> Bool)
-> (TableKind -> TableKind -> TableKind)
-> (TableKind -> TableKind -> TableKind)
-> Ord TableKind
TableKind -> TableKind -> Bool
TableKind -> TableKind -> Ordering
TableKind -> TableKind -> TableKind
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TableKind -> TableKind -> Ordering
compare :: TableKind -> TableKind -> Ordering
$c< :: TableKind -> TableKind -> Bool
< :: TableKind -> TableKind -> Bool
$c<= :: TableKind -> TableKind -> Bool
<= :: TableKind -> TableKind -> Bool
$c> :: TableKind -> TableKind -> Bool
> :: TableKind -> TableKind -> Bool
$c>= :: TableKind -> TableKind -> Bool
>= :: TableKind -> TableKind -> Bool
$cmax :: TableKind -> TableKind -> TableKind
max :: TableKind -> TableKind -> TableKind
$cmin :: TableKind -> TableKind -> TableKind
min :: TableKind -> TableKind -> TableKind
Ord, Int -> TableKind -> ShowS
[TableKind] -> ShowS
TableKind -> String
(Int -> TableKind -> ShowS)
-> (TableKind -> String)
-> ([TableKind] -> ShowS)
-> Show TableKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableKind -> ShowS
showsPrec :: Int -> TableKind -> ShowS
$cshow :: TableKind -> String
show :: TableKind -> String
$cshowList :: [TableKind] -> ShowS
showList :: [TableKind] -> ShowS
Show, ReadPrec [TableKind]
ReadPrec TableKind
Int -> ReadS TableKind
ReadS [TableKind]
(Int -> ReadS TableKind)
-> ReadS [TableKind]
-> ReadPrec TableKind
-> ReadPrec [TableKind]
-> Read TableKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TableKind
readsPrec :: Int -> ReadS TableKind
$creadList :: ReadS [TableKind]
readList :: ReadS [TableKind]
$creadPrec :: ReadPrec TableKind
readPrec :: ReadPrec TableKind
$creadListPrec :: ReadPrec [TableKind]
readListPrec :: ReadPrec [TableKind]
Read, Int -> TableKind
TableKind -> Int
TableKind -> [TableKind]
TableKind -> TableKind
TableKind -> TableKind -> [TableKind]
TableKind -> TableKind -> TableKind -> [TableKind]
(TableKind -> TableKind)
-> (TableKind -> TableKind)
-> (Int -> TableKind)
-> (TableKind -> Int)
-> (TableKind -> [TableKind])
-> (TableKind -> TableKind -> [TableKind])
-> (TableKind -> TableKind -> [TableKind])
-> (TableKind -> TableKind -> TableKind -> [TableKind])
-> Enum TableKind
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TableKind -> TableKind
succ :: TableKind -> TableKind
$cpred :: TableKind -> TableKind
pred :: TableKind -> TableKind
$ctoEnum :: Int -> TableKind
toEnum :: Int -> TableKind
$cfromEnum :: TableKind -> Int
fromEnum :: TableKind -> Int
$cenumFrom :: TableKind -> [TableKind]
enumFrom :: TableKind -> [TableKind]
$cenumFromThen :: TableKind -> TableKind -> [TableKind]
enumFromThen :: TableKind -> TableKind -> [TableKind]
$cenumFromTo :: TableKind -> TableKind -> [TableKind]
enumFromTo :: TableKind -> TableKind -> [TableKind]
$cenumFromThenTo :: TableKind -> TableKind -> TableKind -> [TableKind]
enumFromThenTo :: TableKind -> TableKind -> TableKind -> [TableKind]
Enum, TableKind
TableKind -> TableKind -> Bounded TableKind
forall a. a -> a -> Bounded a
$cminBound :: TableKind
minBound :: TableKind
$cmaxBound :: TableKind
maxBound :: TableKind
Bounded)

-- | A table or view with its columns and constraints.
data Table = Table
  { Table -> ObjectName
tableName :: !ObjectName
  , Table -> TableKind
tableKind :: !TableKind
  , Table -> [Column]
tableColumns :: ![Column]
    -- ^ In column order.
  , Table -> Maybe KeyConstraint
tablePrimaryKey :: !(Maybe KeyConstraint)
  , Table -> [KeyConstraint]
tableUniqueKeys :: ![KeyConstraint]
    -- ^ The @UNIQUE@ constraints, by name.  (Unique indexes that are not
    -- constraints are not read.)
  , Table -> [ForeignKey]
tableForeignKeys :: ![ForeignKey]
    -- ^ By name.
  }

instance Show Table where
  showsPrec :: Int -> Table -> ShowS
showsPrec Int
p (Table ObjectName
a TableKind
b [Column]
c Maybe KeyConstraint
e [KeyConstraint]
f [ForeignKey]
g) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"Table"#
    [ Addr#
"tableName"# Addr# -> ObjectName -> Field
forall a. Show a => Addr# -> a -> Field
:= ObjectName
a, Addr#
"tableKind"# Addr# -> TableKind -> Field
forall a. Show a => Addr# -> a -> Field
:= TableKind
b, Addr#
"tableColumns"# Addr# -> [Column] -> Field
forall a. Show a => Addr# -> a -> Field
:= [Column]
c, Addr#
"tablePrimaryKey"# Addr# -> Maybe KeyConstraint -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe KeyConstraint
e
    , Addr#
"tableUniqueKeys"# Addr# -> [KeyConstraint] -> Field
forall a. Show a => Addr# -> a -> Field
:= [KeyConstraint]
f, Addr#
"tableForeignKeys"# Addr# -> [ForeignKey] -> Field
forall a. Show a => Addr# -> a -> Field
:= [ForeignKey]
g
    ]
  {-# OPAQUE showsPrec #-}

instance Eq Table where
  Table ObjectName
a TableKind
b [Column]
c Maybe KeyConstraint
e [KeyConstraint]
f [ForeignKey]
g == :: Table -> Table -> Bool
== Table ObjectName
a' TableKind
b' [Column]
c' Maybe KeyConstraint
e' [KeyConstraint]
f' [ForeignKey]
g' =
    ObjectName -> ObjectName -> Bool
forall a. Eq a => a -> a -> Bool
eq ObjectName
a ObjectName
a' Bool -> Bool -> Bool
&& TableKind -> TableKind -> Bool
forall a. Eq a => a -> a -> Bool
eq TableKind
b TableKind
b' Bool -> Bool -> Bool
&& [Column] -> [Column] -> Bool
forall a. Eq a => a -> a -> Bool
eq [Column]
c [Column]
c' Bool -> Bool -> Bool
&& Maybe KeyConstraint -> Maybe KeyConstraint -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe KeyConstraint
e Maybe KeyConstraint
e' Bool -> Bool -> Bool
&& [KeyConstraint] -> [KeyConstraint] -> Bool
forall a. Eq a => a -> a -> Bool
eq [KeyConstraint]
f [KeyConstraint]
f' Bool -> Bool -> Bool
&& [ForeignKey] -> [ForeignKey] -> Bool
forall a. Eq a => a -> a -> Bool
eq [ForeignKey]
g [ForeignKey]
g'
  {-# OPAQUE (==) #-}

-- | A column of a table or view.
data Column = Column
  { Column -> Text
colName :: !Text
  , Column -> Int
colId :: !Int
    -- ^ @column_id@: a column's position, with gaps where columns were
    -- dropped.
  , Column -> Text
colTypeName :: !Text
    -- ^ The type the column is declared with, as named: a system type
    -- (@nvarchar@, @sysname@, @vector@, @hierarchyid@), or a user-defined
    -- type with its schema (@dbo.phone@).
  , Column -> Maybe SqlType
colType :: !(Maybe SqlType)
    -- ^ The type with its arguments, an alias type resolved to what it is
    -- based on.  'Nothing' for a CLR user-defined type other than
    -- @hierarchyid@, @geometry@ and @geography@, and for a type newer
    -- than this library.
  , Column -> Bool
colNullable :: !Bool
  , Column -> Maybe Text
colCollation :: !(Maybe Text)
    -- ^ Character types only.
  , Column -> Bool
colIdentity :: !Bool
  , Column -> Maybe Computed
colComputed :: !(Maybe Computed)
  , Column -> Maybe Text
colDefault :: !(Maybe Text)
    -- ^ The default constraint's expression as the catalog stores it,
    -- e.g. @((0))@ or @(getdate())@.
  , Column -> Maybe GeneratedAlways
colGenerated :: !(Maybe GeneratedAlways)
    -- ^ A column the server maintains: a system-versioned (temporal)
    -- table's period, or a ledger table's.
  , Column -> Bool
colHidden :: !Bool
    -- ^ Left out of @SELECT *@.
  }

instance Show Column where
  showsPrec :: Int -> Column -> ShowS
showsPrec Int
p (Column Text
a Int
b Text
c Maybe SqlType
e Bool
f Maybe Text
g Bool
h Maybe Computed
i Maybe Text
j Maybe GeneratedAlways
k Bool
l) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"Column"#
    [ Addr#
"colName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"colId"# Addr# -> Int -> Field
forall a. Show a => Addr# -> a -> Field
:= Int
b, Addr#
"colTypeName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
c, Addr#
"colType"# Addr# -> Maybe SqlType -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe SqlType
e, Addr#
"colNullable"# Addr# -> Bool -> Field
forall a. Show a => Addr# -> a -> Field
:= Bool
f
    , Addr#
"colCollation"# Addr# -> Maybe Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe Text
g, Addr#
"colIdentity"# Addr# -> Bool -> Field
forall a. Show a => Addr# -> a -> Field
:= Bool
h, Addr#
"colComputed"# Addr# -> Maybe Computed -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe Computed
i, Addr#
"colDefault"# Addr# -> Maybe Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe Text
j
    , Addr#
"colGenerated"# Addr# -> Maybe GeneratedAlways -> Field
forall a. Show a => Addr# -> a -> Field
:= Maybe GeneratedAlways
k, Addr#
"colHidden"# Addr# -> Bool -> Field
forall a. Show a => Addr# -> a -> Field
:= Bool
l
    ]
  {-# OPAQUE showsPrec #-}

instance Eq Column where
  Column Text
a Int
b Text
c Maybe SqlType
e Bool
f Maybe Text
g Bool
h Maybe Computed
i Maybe Text
j Maybe GeneratedAlways
k Bool
l == :: Column -> Column -> Bool
== Column Text
a' Int
b' Text
c' Maybe SqlType
e' Bool
f' Maybe Text
g' Bool
h' Maybe Computed
i' Maybe Text
j' Maybe GeneratedAlways
k' Bool
l' =
    Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b' Bool -> Bool -> Bool
&& Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
c Text
c' Bool -> Bool -> Bool
&& Maybe SqlType -> Maybe SqlType -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe SqlType
e Maybe SqlType
e' Bool -> Bool -> Bool
&& Bool
f Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
f' Bool -> Bool -> Bool
&& Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe Text
g Maybe Text
g' Bool -> Bool -> Bool
&& Bool
h Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
h' Bool -> Bool -> Bool
&& Maybe Computed -> Maybe Computed -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe Computed
i Maybe Computed
i'
      Bool -> Bool -> Bool
&& Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe Text
j Maybe Text
j' Bool -> Bool -> Bool
&& Maybe GeneratedAlways -> Maybe GeneratedAlways -> Bool
forall a. Eq a => a -> a -> Bool
eq Maybe GeneratedAlways
k Maybe GeneratedAlways
k' Bool -> Bool -> Bool
&& Bool
l Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
l'
  {-# OPAQUE (==) #-}

-- | A computed column's expression, and whether it is stored.
data Computed = Computed
  { Computed -> Text
computedDefinition :: !Text
  , Computed -> Bool
computedPersisted :: !Bool
  }

instance Show Computed where
  showsPrec :: Int -> Computed -> ShowS
showsPrec Int
p (Computed Text
a Bool
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"Computed"# [Addr#
"computedDefinition"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"computedPersisted"# Addr# -> Bool -> Field
forall a. Show a => Addr# -> a -> Field
:= Bool
b]
  {-# OPAQUE showsPrec #-}

instance Eq Computed where
  Computed Text
a Bool
b == :: Computed -> Computed -> Bool
== Computed Text
a' Bool
b' = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& Bool
b Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
b'
  {-# OPAQUE (==) #-}

-- | @sys.columns.generated_always_type@.
data GeneratedAlways
  = AsRowStart
  | AsRowEnd
  | AsTransactionIdStart
  | AsTransactionIdEnd
  | AsSequenceNumberStart
  | AsSequenceNumberEnd
  | AsOther !Int
    -- ^ A kind this library doesn't know, with the catalog's number.
  deriving stock (Eq GeneratedAlways
Eq GeneratedAlways =>
(GeneratedAlways -> GeneratedAlways -> Ordering)
-> (GeneratedAlways -> GeneratedAlways -> Bool)
-> (GeneratedAlways -> GeneratedAlways -> Bool)
-> (GeneratedAlways -> GeneratedAlways -> Bool)
-> (GeneratedAlways -> GeneratedAlways -> Bool)
-> (GeneratedAlways -> GeneratedAlways -> GeneratedAlways)
-> (GeneratedAlways -> GeneratedAlways -> GeneratedAlways)
-> Ord GeneratedAlways
GeneratedAlways -> GeneratedAlways -> Bool
GeneratedAlways -> GeneratedAlways -> Ordering
GeneratedAlways -> GeneratedAlways -> GeneratedAlways
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GeneratedAlways -> GeneratedAlways -> Ordering
compare :: GeneratedAlways -> GeneratedAlways -> Ordering
$c< :: GeneratedAlways -> GeneratedAlways -> Bool
< :: GeneratedAlways -> GeneratedAlways -> Bool
$c<= :: GeneratedAlways -> GeneratedAlways -> Bool
<= :: GeneratedAlways -> GeneratedAlways -> Bool
$c> :: GeneratedAlways -> GeneratedAlways -> Bool
> :: GeneratedAlways -> GeneratedAlways -> Bool
$c>= :: GeneratedAlways -> GeneratedAlways -> Bool
>= :: GeneratedAlways -> GeneratedAlways -> Bool
$cmax :: GeneratedAlways -> GeneratedAlways -> GeneratedAlways
max :: GeneratedAlways -> GeneratedAlways -> GeneratedAlways
$cmin :: GeneratedAlways -> GeneratedAlways -> GeneratedAlways
min :: GeneratedAlways -> GeneratedAlways -> GeneratedAlways
Ord)

instance Show GeneratedAlways where
  showsPrec :: Int -> GeneratedAlways -> ShowS
showsPrec Int
p = \case
    GeneratedAlways
AsRowStart -> String -> ShowS
showString String
"AsRowStart"
    GeneratedAlways
AsRowEnd -> String -> ShowS
showString String
"AsRowEnd"
    GeneratedAlways
AsTransactionIdStart -> String -> ShowS
showString String
"AsTransactionIdStart"
    GeneratedAlways
AsTransactionIdEnd -> String -> ShowS
showString String
"AsTransactionIdEnd"
    GeneratedAlways
AsSequenceNumberStart -> String -> ShowS
showString String
"AsSequenceNumberStart"
    GeneratedAlways
AsSequenceNumberEnd -> String -> ShowS
showString String
"AsSequenceNumberEnd"
    AsOther Int
a -> Int -> Addr# -> Int -> ShowS
forall a. Show a => Int -> Addr# -> a -> ShowS
showCon1 Int
p Addr#
"AsOther"# Int
a
  {-# OPAQUE showsPrec #-}

instance Eq GeneratedAlways where
  GeneratedAlways
x == :: GeneratedAlways -> GeneratedAlways -> Bool
== GeneratedAlways
y = case (GeneratedAlways
x, GeneratedAlways
y) of
    (GeneratedAlways
AsRowStart, GeneratedAlways
AsRowStart) -> Bool
True
    (GeneratedAlways
AsRowEnd, GeneratedAlways
AsRowEnd) -> Bool
True
    (GeneratedAlways
AsTransactionIdStart, GeneratedAlways
AsTransactionIdStart) -> Bool
True
    (GeneratedAlways
AsTransactionIdEnd, GeneratedAlways
AsTransactionIdEnd) -> Bool
True
    (GeneratedAlways
AsSequenceNumberStart, GeneratedAlways
AsSequenceNumberStart) -> Bool
True
    (GeneratedAlways
AsSequenceNumberEnd, GeneratedAlways
AsSequenceNumberEnd) -> Bool
True
    (AsOther Int
a, AsOther Int
a') -> Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
a'
    (GeneratedAlways, GeneratedAlways)
_ -> Bool
False
  {-# OPAQUE (==) #-}

-- | A primary key or unique constraint.
data KeyConstraint = KeyConstraint
  { KeyConstraint -> Text
keyName :: !Text
  , KeyConstraint -> [Text]
keyColumns :: ![Text]
    -- ^ In key order.
  }

instance Show KeyConstraint where
  showsPrec :: Int -> KeyConstraint -> ShowS
showsPrec Int
p (KeyConstraint Text
a [Text]
b) =
    Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"KeyConstraint"# [Addr#
"keyName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"keyColumns"# Addr# -> [Text] -> Field
forall a. Show a => Addr# -> a -> Field
:= [Text]
b]
  {-# OPAQUE showsPrec #-}

instance Eq KeyConstraint where
  KeyConstraint Text
a [Text]
b == :: KeyConstraint -> KeyConstraint -> Bool
== KeyConstraint Text
a' [Text]
b' = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
eq [Text]
b [Text]
b'
  {-# OPAQUE (==) #-}

-- | A foreign key constraint.
data ForeignKey = ForeignKey
  { ForeignKey -> Text
fkName :: !Text
  , ForeignKey -> [Text]
fkColumns :: ![Text]
    -- ^ The referencing columns, paired with 'fkReferencedColumns'.
  , ForeignKey -> ObjectName
fkReferencedTable :: !ObjectName
  , ForeignKey -> [Text]
fkReferencedColumns :: ![Text]
  }

instance Show ForeignKey where
  showsPrec :: Int -> ForeignKey -> ShowS
showsPrec Int
p (ForeignKey Text
a [Text]
b ObjectName
c [Text]
e) = Int -> Addr# -> [Field] -> ShowS
showRecord Int
p Addr#
"ForeignKey"#
    [ Addr#
"fkName"# Addr# -> Text -> Field
forall a. Show a => Addr# -> a -> Field
:= Text
a, Addr#
"fkColumns"# Addr# -> [Text] -> Field
forall a. Show a => Addr# -> a -> Field
:= [Text]
b, Addr#
"fkReferencedTable"# Addr# -> ObjectName -> Field
forall a. Show a => Addr# -> a -> Field
:= ObjectName
c
    , Addr#
"fkReferencedColumns"# Addr# -> [Text] -> Field
forall a. Show a => Addr# -> a -> Field
:= [Text]
e
    ]
  {-# OPAQUE showsPrec #-}

instance Eq ForeignKey where
  ForeignKey Text
a [Text]
b ObjectName
c [Text]
e == :: ForeignKey -> ForeignKey -> Bool
== ForeignKey Text
a' [Text]
b' ObjectName
c' [Text]
e' = Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
eq Text
a Text
a' Bool -> Bool -> Bool
&& [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
eq [Text]
b [Text]
b' Bool -> Bool -> Bool
&& ObjectName -> ObjectName -> Bool
forall a. Eq a => a -> a -> Bool
eq ObjectName
c ObjectName
c' Bool -> Bool -> Bool
&& [Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
eq [Text]
e [Text]
e'
  {-# OPAQUE (==) #-}

-- | The column of this name (exact match, as the catalog names it).
lookupColumn :: Table -> Text -> Maybe Column
lookupColumn :: Table -> Text -> Maybe Column
lookupColumn Table
t Text
name = (Column -> Bool) -> [Column] -> Maybe Column
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) (Text -> Bool) -> (Column -> Text) -> Column -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Column -> Text
colName) (Table -> [Column]
tableColumns Table
t)

------------------------------------------------------------------------------
-- Reading the catalog

-- | Every user table and view the login can see, in every schema, in name
-- order.  Objects marked as shipped by Microsoft are left out.
readTables :: Connection -> IO [Table]
readTables :: Connection -> IO [Table]
readTables Connection
conn = Connection -> Maybe Text -> Maybe Text -> IO [Table]
readCatalog Connection
conn Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing

-- | The user tables and views of one schema.
readTablesIn :: Connection -> Text -> IO [Table]
readTablesIn :: Connection -> Text -> IO [Table]
readTablesIn Connection
conn Text
schema = Connection -> Maybe Text -> Maybe Text -> IO [Table]
readCatalog Connection
conn (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
schema) Maybe Text
forall a. Maybe a
Nothing

-- | One table or view, if it exists.
readTable :: Connection -> ObjectName -> IO (Maybe Table)
readTable :: Connection -> ObjectName -> IO (Maybe Table)
readTable Connection
conn (ObjectName Text
schema Text
name) = [Table] -> Maybe Table
forall {a}. [a] -> Maybe a
case' ([Table] -> Maybe Table) -> IO [Table] -> IO (Maybe Table)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Maybe Text -> Maybe Text -> IO [Table]
readCatalog Connection
conn (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
schema) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name)
  where
    case' :: [a] -> Maybe a
case' = \case
      [a
t] -> a -> Maybe a
forall a. a -> Maybe a
Just a
t
      [a]
_ -> Maybe a
forall a. Maybe a
Nothing

-- | One row of the column query, in SELECT order.
data ColumnRow = ColumnRow
  { ColumnRow -> Text
rSchema :: Text
  , ColumnRow -> Text
rObject :: Text
  , ColumnRow -> Bool
rIsView :: Bool
  , ColumnRow -> Int
rColumnId :: Int
  , ColumnRow -> Text
rColumn :: Text
  , ColumnRow -> Text
rTypeSchema :: Text
  , ColumnRow -> Text
rTypeName :: Text
  , ColumnRow -> Bool
rTypeUserDefined :: Bool
  , ColumnRow -> Bool
rTypeClr :: Bool
  , ColumnRow -> Maybe Text
rBaseTypeName :: Maybe Text
  , ColumnRow -> Int
rMaxLength :: Int
  , ColumnRow -> Int
rPrecision :: Int
  , ColumnRow -> Int
rScale :: Int
  , ColumnRow -> Maybe Text
rCollation :: Maybe Text
  , ColumnRow -> Bool
rNullable :: Bool
  , ColumnRow -> Bool
rIdentity :: Bool
  , ColumnRow -> Maybe Text
rComputedDefinition :: Maybe Text
  , ColumnRow -> Maybe Bool
rComputedPersisted :: Maybe Bool
  , ColumnRow -> Maybe Text
rDefault :: Maybe Text
  , ColumnRow -> Int
rGeneratedAlways :: Int
  , ColumnRow -> Bool
rHidden :: Bool
  , ColumnRow -> Maybe Text
rXmlSchema :: Maybe Text
  , ColumnRow -> Maybe Text
rXmlCollection :: Maybe Text
  }
  deriving stock ((forall x. ColumnRow -> Rep ColumnRow x)
-> (forall x. Rep ColumnRow x -> ColumnRow) -> Generic ColumnRow
forall x. Rep ColumnRow x -> ColumnRow
forall x. ColumnRow -> Rep ColumnRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnRow -> Rep ColumnRow x
from :: forall x. ColumnRow -> Rep ColumnRow x
$cto :: forall x. Rep ColumnRow x -> ColumnRow
to :: forall x. Rep ColumnRow x -> ColumnRow
Generic)
  deriving anyclass (RowDecoder ColumnRow
RowDecoder ColumnRow -> FromSqlRow ColumnRow
forall a. RowDecoder a -> FromSqlRow a
$crowDecoder :: RowDecoder ColumnRow
rowDecoder :: RowDecoder ColumnRow
FromSqlRow)

data KeyRow = KeyRow
  { KeyRow -> Text
kSchema :: Text
  , KeyRow -> Text
kObject :: Text
  , KeyRow -> Text
kName :: Text
  , KeyRow -> Bool
kIsPrimary :: Bool
  , KeyRow -> Int
kOrdinal :: Int
  , KeyRow -> Text
kColumn :: Text
  }
  deriving stock ((forall x. KeyRow -> Rep KeyRow x)
-> (forall x. Rep KeyRow x -> KeyRow) -> Generic KeyRow
forall x. Rep KeyRow x -> KeyRow
forall x. KeyRow -> Rep KeyRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyRow -> Rep KeyRow x
from :: forall x. KeyRow -> Rep KeyRow x
$cto :: forall x. Rep KeyRow x -> KeyRow
to :: forall x. Rep KeyRow x -> KeyRow
Generic)
  deriving anyclass (RowDecoder KeyRow
RowDecoder KeyRow -> FromSqlRow KeyRow
forall a. RowDecoder a -> FromSqlRow a
$crowDecoder :: RowDecoder KeyRow
rowDecoder :: RowDecoder KeyRow
FromSqlRow)

data FkRow = FkRow
  { FkRow -> Text
fSchema :: Text
  , FkRow -> Text
fObject :: Text
  , FkRow -> Text
fName :: Text
  , FkRow -> Text
fReferencedSchema :: Text
  , FkRow -> Text
fReferencedObject :: Text
  , FkRow -> Int
fOrdinal :: Int
  , FkRow -> Text
fColumn :: Text
  , FkRow -> Text
fReferencedColumn :: Text
  }
  deriving stock ((forall x. FkRow -> Rep FkRow x)
-> (forall x. Rep FkRow x -> FkRow) -> Generic FkRow
forall x. Rep FkRow x -> FkRow
forall x. FkRow -> Rep FkRow x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FkRow -> Rep FkRow x
from :: forall x. FkRow -> Rep FkRow x
$cto :: forall x. Rep FkRow x -> FkRow
to :: forall x. Rep FkRow x -> FkRow
Generic)
  deriving anyclass (RowDecoder FkRow
RowDecoder FkRow -> FromSqlRow FkRow
forall a. RowDecoder a -> FromSqlRow a
$crowDecoder :: RowDecoder FkRow
rowDecoder :: RowDecoder FkRow
FromSqlRow)

-- | The three catalog queries as one statement (one request), each
-- restricted to the schema and object given.
catalogSql :: Text
catalogSql :: Text
catalogSql = Text -> [Text] -> Text
T.intercalate Text
";\n"
  [ Text
"SELECT s.name, o.name, CAST(CASE o.type WHEN 'V' THEN 1 ELSE 0 END AS bit), c.column_id, c.name,\n\
    \  tys.name, ty.name, ty.is_user_defined, ty.is_assembly_type, base.name,\n\
    \  CAST(c.max_length AS int), CAST(c.precision AS int), CAST(c.scale AS int), c.collation_name, c.is_nullable,\n\
    \  c.is_identity, cc.definition, cc.is_persisted, dc.definition, CAST(c.generated_always_type AS int), c.is_hidden,\n\
    \  xs.name, xsc.name\n\
    \FROM sys.objects AS o\n\
    \JOIN sys.schemas AS s ON s.schema_id = o.schema_id\n\
    \JOIN sys.columns AS c ON c.object_id = o.object_id\n\
    \JOIN sys.types AS ty ON ty.user_type_id = c.user_type_id\n\
    \JOIN sys.schemas AS tys ON tys.schema_id = ty.schema_id\n\
    \LEFT JOIN sys.types AS base ON ty.is_user_defined = 1 AND base.user_type_id = ty.system_type_id\n\
    \LEFT JOIN sys.computed_columns AS cc ON cc.object_id = c.object_id AND cc.column_id = c.column_id\n\
    \LEFT JOIN sys.default_constraints AS dc ON dc.object_id = c.default_object_id\n\
    \LEFT JOIN sys.xml_schema_collections AS xsc ON xsc.xml_collection_id = c.xml_collection_id\n\
    \LEFT JOIN sys.schemas AS xs ON xs.schema_id = xsc.schema_id\n\
    \WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
objectFilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
    \ORDER BY s.name, o.name, c.column_id"
  , Text
"SELECT s.name, o.name, kc.name, CAST(CASE kc.type WHEN 'PK' THEN 1 ELSE 0 END AS bit), CAST(ic.key_ordinal AS int), c.name\n\
    \FROM sys.key_constraints AS kc\n\
    \JOIN sys.objects AS o ON o.object_id = kc.parent_object_id\n\
    \JOIN sys.schemas AS s ON s.schema_id = o.schema_id\n\
    \JOIN sys.index_columns AS ic ON ic.object_id = kc.parent_object_id AND ic.index_id = kc.unique_index_id\n\
    \JOIN sys.columns AS c ON c.object_id = ic.object_id AND c.column_id = ic.column_id\n\
    \WHERE ic.key_ordinal > 0 AND " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
objectFilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
    \ORDER BY s.name, o.name, kc.name, ic.key_ordinal"
  , Text
"SELECT s.name, o.name, fk.name, rs.name, ro.name, fkc.constraint_column_id, pc.name, rc.name\n\
    \FROM sys.foreign_keys AS fk\n\
    \JOIN sys.objects AS o ON o.object_id = fk.parent_object_id\n\
    \JOIN sys.schemas AS s ON s.schema_id = o.schema_id\n\
    \JOIN sys.objects AS ro ON ro.object_id = fk.referenced_object_id\n\
    \JOIN sys.schemas AS rs ON rs.schema_id = ro.schema_id\n\
    \JOIN sys.foreign_key_columns AS fkc ON fkc.constraint_object_id = fk.object_id\n\
    \JOIN sys.columns AS pc ON pc.object_id = fkc.parent_object_id AND pc.column_id = fkc.parent_column_id\n\
    \JOIN sys.columns AS rc ON rc.object_id = fkc.referenced_object_id AND rc.column_id = fkc.referenced_column_id\n\
    \WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
objectFilter Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\
    \ORDER BY s.name, o.name, fk.name, fkc.constraint_column_id"
  ]
  where
    objectFilter :: Text
objectFilter =
      Text
"o.type IN ('U', 'V') AND o.is_ms_shipped = 0\
      \ AND (@p1 IS NULL OR s.name = @p1) AND (@p2 IS NULL OR o.name = @p2)"

readCatalog :: Connection -> Maybe Text -> Maybe Text -> IO [Table]
readCatalog :: Connection -> Maybe Text -> Maybe Text -> IO [Table]
readCatalog Connection
conn Maybe Text
schema Maybe Text
object = do
  (columns, keys, fks) <- ResultSets ([ColumnRow], [KeyRow], [FkRow])
-> Connection -> Query -> IO ([ColumnRow], [KeyRow], [FkRow])
forall a. ResultSets a -> Connection -> Query -> IO a
queryResultSets ((,,) ([ColumnRow]
 -> [KeyRow] -> [FkRow] -> ([ColumnRow], [KeyRow], [FkRow]))
-> ResultSets [ColumnRow]
-> ResultSets
     ([KeyRow] -> [FkRow] -> ([ColumnRow], [KeyRow], [FkRow]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ResultSets [ColumnRow]
forall r. FromSqlRow r => ResultSets [r]
resultSet ResultSets
  ([KeyRow] -> [FkRow] -> ([ColumnRow], [KeyRow], [FkRow]))
-> ResultSets [KeyRow]
-> ResultSets ([FkRow] -> ([ColumnRow], [KeyRow], [FkRow]))
forall a b. ResultSets (a -> b) -> ResultSets a -> ResultSets b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResultSets [KeyRow]
forall r. FromSqlRow r => ResultSets [r]
resultSet ResultSets ([FkRow] -> ([ColumnRow], [KeyRow], [FkRow]))
-> ResultSets [FkRow]
-> ResultSets ([ColumnRow], [KeyRow], [FkRow])
forall a b. ResultSets (a -> b) -> ResultSets a -> ResultSets b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ResultSets [FkRow]
forall r. FromSqlRow r => ResultSets [r]
resultSet) Connection
conn (Text -> (Maybe Text, Maybe Text) -> Query
forall p. ToSqlRow p => Text -> p -> Query
mkQuery Text
catalogSql (Maybe Text
schema, Maybe Text
object))
  let keysOf = ([(Bool, KeyConstraint)]
 -> [(Bool, KeyConstraint)] -> [(Bool, KeyConstraint)])
-> [(ObjectName, [(Bool, KeyConstraint)])]
-> Map ObjectName [(Bool, KeyConstraint)]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (([(Bool, KeyConstraint)]
 -> [(Bool, KeyConstraint)] -> [(Bool, KeyConstraint)])
-> [(Bool, KeyConstraint)]
-> [(Bool, KeyConstraint)]
-> [(Bool, KeyConstraint)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [(Bool, KeyConstraint)]
-> [(Bool, KeyConstraint)] -> [(Bool, KeyConstraint)]
forall a. [a] -> [a] -> [a]
(++))
        [ (Text -> Text -> ObjectName
ObjectName (KeyRow -> Text
kSchema KeyRow
r) (KeyRow -> Text
kObject KeyRow
r), [(KeyRow -> Bool
kIsPrimary KeyRow
r, Text -> [Text] -> KeyConstraint
KeyConstraint (KeyRow -> Text
kName KeyRow
r) ((KeyRow -> Text) -> [KeyRow] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map KeyRow -> Text
kColumn [KeyRow]
rs))])
        | rs :: [KeyRow]
rs@(KeyRow
r : [KeyRow]
_) <- (KeyRow -> KeyRow -> Bool) -> [KeyRow] -> [[KeyRow]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Text, Text, Text) -> (Text, Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Text, Text, Text) -> (Text, Text, Text) -> Bool)
-> (KeyRow -> (Text, Text, Text)) -> KeyRow -> KeyRow -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \KeyRow
r -> (KeyRow -> Text
kSchema KeyRow
r, KeyRow -> Text
kObject KeyRow
r, KeyRow -> Text
kName KeyRow
r)) [KeyRow]
keys ]
      fksOf = ([ForeignKey] -> [ForeignKey] -> [ForeignKey])
-> [(ObjectName, [ForeignKey])] -> Map ObjectName [ForeignKey]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (([ForeignKey] -> [ForeignKey] -> [ForeignKey])
-> [ForeignKey] -> [ForeignKey] -> [ForeignKey]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [ForeignKey] -> [ForeignKey] -> [ForeignKey]
forall a. [a] -> [a] -> [a]
(++))
        [ (Text -> Text -> ObjectName
ObjectName (FkRow -> Text
fSchema FkRow
r) (FkRow -> Text
fObject FkRow
r), [Text -> [Text] -> ObjectName -> [Text] -> ForeignKey
ForeignKey (FkRow -> Text
fName FkRow
r) ((FkRow -> Text) -> [FkRow] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FkRow -> Text
fColumn [FkRow]
rs) (Text -> Text -> ObjectName
ObjectName (FkRow -> Text
fReferencedSchema FkRow
r) (FkRow -> Text
fReferencedObject FkRow
r)) ((FkRow -> Text) -> [FkRow] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map FkRow -> Text
fReferencedColumn [FkRow]
rs)])
        | rs :: [FkRow]
rs@(FkRow
r : [FkRow]
_) <- (FkRow -> FkRow -> Bool) -> [FkRow] -> [[FkRow]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy ((Text, Text, Text) -> (Text, Text, Text) -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((Text, Text, Text) -> (Text, Text, Text) -> Bool)
-> (FkRow -> (Text, Text, Text)) -> FkRow -> FkRow -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` \FkRow
r -> (FkRow -> Text
fSchema FkRow
r, FkRow -> Text
fObject FkRow
r, FkRow -> Text
fName FkRow
r)) [FkRow]
fks ]
      table rs :: [ColumnRow]
rs@(ColumnRow
r : [ColumnRow]
_) =
        let name :: ObjectName
name = Text -> Text -> ObjectName
ObjectName (ColumnRow -> Text
rSchema ColumnRow
r) (ColumnRow -> Text
rObject ColumnRow
r)
            ks :: [(Bool, KeyConstraint)]
ks = [(Bool, KeyConstraint)]
-> ObjectName
-> Map ObjectName [(Bool, KeyConstraint)]
-> [(Bool, KeyConstraint)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ObjectName
name Map ObjectName [(Bool, KeyConstraint)]
keysOf
         in Table
              { tableName :: ObjectName
tableName = ObjectName
name
              , tableKind :: TableKind
tableKind = if ColumnRow -> Bool
rIsView ColumnRow
r then TableKind
View else TableKind
UserTable
              , tableColumns :: [Column]
tableColumns = (ColumnRow -> Column) -> [ColumnRow] -> [Column]
forall a b. (a -> b) -> [a] -> [b]
map ColumnRow -> Column
toColumn [ColumnRow]
rs
              , tablePrimaryKey :: Maybe KeyConstraint
tablePrimaryKey = Bool -> [(Bool, KeyConstraint)] -> Maybe KeyConstraint
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Bool
True [(Bool, KeyConstraint)]
ks
              , tableUniqueKeys :: [KeyConstraint]
tableUniqueKeys = [KeyConstraint
k | (Bool
False, KeyConstraint
k) <- [(Bool, KeyConstraint)]
ks]
              , tableForeignKeys :: [ForeignKey]
tableForeignKeys = [ForeignKey]
-> ObjectName -> Map ObjectName [ForeignKey] -> [ForeignKey]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] ObjectName
name Map ObjectName [ForeignKey]
fksOf
              }
      table [] = String -> Table
forall a. HasCallStack => String -> a
error String
"readCatalog: empty group"
  pure (map table (groupBy ((==) `on` \ColumnRow
r -> (ColumnRow -> Text
rSchema ColumnRow
r, ColumnRow -> Text
rObject ColumnRow
r)) columns))

toColumn :: ColumnRow -> Column
toColumn :: ColumnRow -> Column
toColumn ColumnRow
r = Column
  { colName :: Text
colName = ColumnRow -> Text
rColumn ColumnRow
r
  , colId :: Int
colId = ColumnRow -> Int
rColumnId ColumnRow
r
  , colTypeName :: Text
colTypeName = if ColumnRow -> Text
rTypeSchema ColumnRow
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"sys" then ColumnRow -> Text
rTypeName ColumnRow
r else ColumnRow -> Text
rTypeSchema ColumnRow
r Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ColumnRow -> Text
rTypeName ColumnRow
r
  , colType :: Maybe SqlType
colType = SqlDataType -> TypeArgs -> SqlType
SqlType (SqlDataType -> TypeArgs -> SqlType)
-> Maybe SqlDataType -> Maybe (TypeArgs -> SqlType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SqlDataType
dataType Maybe (TypeArgs -> SqlType) -> Maybe TypeArgs -> Maybe SqlType
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> TypeArgs -> Maybe TypeArgs
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeArgs
args
  , colNullable :: Bool
colNullable = ColumnRow -> Bool
rNullable ColumnRow
r
  , colCollation :: Maybe Text
colCollation = ColumnRow -> Maybe Text
rCollation ColumnRow
r
  , colIdentity :: Bool
colIdentity = ColumnRow -> Bool
rIdentity ColumnRow
r
  , colComputed :: Maybe Computed
colComputed = Text -> Bool -> Computed
Computed (Text -> Bool -> Computed)
-> Maybe Text -> Maybe (Bool -> Computed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ColumnRow -> Maybe Text
rComputedDefinition ColumnRow
r Maybe (Bool -> Computed) -> Maybe Bool -> Maybe Computed
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ColumnRow -> Maybe Bool
rComputedPersisted ColumnRow
r Maybe Bool -> Bool -> Maybe Bool
forall {a}. Maybe a -> a -> Maybe a
`orElse` Bool
False)
  , colDefault :: Maybe Text
colDefault = ColumnRow -> Maybe Text
rDefault ColumnRow
r
  , colGenerated :: Maybe GeneratedAlways
colGenerated = case ColumnRow -> Int
rGeneratedAlways ColumnRow
r of
      Int
0 -> Maybe GeneratedAlways
forall a. Maybe a
Nothing
      Int
1 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsRowStart
      Int
2 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsRowEnd
      Int
7 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsTransactionIdStart
      Int
8 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsTransactionIdEnd
      Int
9 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsSequenceNumberStart
      Int
10 -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just GeneratedAlways
AsSequenceNumberEnd
      Int
n -> GeneratedAlways -> Maybe GeneratedAlways
forall a. a -> Maybe a
Just (Int -> GeneratedAlways
AsOther Int
n)
  , colHidden :: Bool
colHidden = ColumnRow -> Bool
rHidden ColumnRow
r
  }
  where
    orElse :: Maybe a -> a -> Maybe a
orElse Maybe a
m a
d = a -> Maybe a
forall a. a -> Maybe a
Just (a -> (a -> a) -> Maybe a -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
d a -> a
forall a. a -> a
id Maybe a
m)
    -- The system type: the declared type's own name, or the base of an
    -- alias type.  A user-defined CLR type is named by the user, so its
    -- name says nothing.
    dataType :: Maybe SqlDataType
dataType
      | ColumnRow -> Bool
rTypeUserDefined ColumnRow
r = ColumnRow -> Maybe Text
rBaseTypeName ColumnRow
r Maybe Text -> (Text -> Maybe SqlDataType) -> Maybe SqlDataType
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe SqlDataType
dataTypeFromName
      | ColumnRow -> Bool
rTypeClr ColumnRow
r Bool -> Bool -> Bool
&& ColumnRow -> Text
rTypeSchema ColumnRow
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"sys" = Maybe SqlDataType
forall a. Maybe a
Nothing
      | Bool
otherwise = Text -> Maybe SqlDataType
dataTypeFromName (ColumnRow -> Text
rTypeName ColumnRow
r)
    args :: TypeArgs
args = case Maybe SqlDataType
dataType of
      Just SqlDataType
TyChar -> Length -> TypeArgs
LengthArg (Int -> Length
bytesLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyVarChar -> Length -> TypeArgs
LengthArg (Int -> Length
bytesLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyBinary -> Length -> TypeArgs
LengthArg (Int -> Length
bytesLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyVarBinary -> Length -> TypeArgs
LengthArg (Int -> Length
bytesLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyNChar -> Length -> TypeArgs
LengthArg (Int -> Length
charsLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyNVarChar -> Length -> TypeArgs
LengthArg (Int -> Length
charsLength (ColumnRow -> Int
rMaxLength ColumnRow
r))
      Just SqlDataType
TyDecimal -> Precision -> Precision -> TypeArgs
PrecisionScaleArg (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rPrecision ColumnRow
r)) (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rScale ColumnRow
r))
      Just SqlDataType
TyNumeric -> Precision -> Precision -> TypeArgs
PrecisionScaleArg (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rPrecision ColumnRow
r)) (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rScale ColumnRow
r))
      Just SqlDataType
TyTime -> Precision -> TypeArgs
ScaleArg (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rScale ColumnRow
r))
      Just SqlDataType
TyDateTime2 -> Precision -> TypeArgs
ScaleArg (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rScale ColumnRow
r))
      Just SqlDataType
TyDateTimeOffset -> Precision -> TypeArgs
ScaleArg (Int -> Precision
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnRow -> Int
rScale ColumnRow
r))
      -- A vector's storage is 8 bytes plus 4 per dimension.
      Just SqlDataType
TyVector -> Int -> TypeArgs
DimensionsArg ((ColumnRow -> Int
rMaxLength ColumnRow
r Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4)
      Just SqlDataType
TyXml | Just Text
schema <- ColumnRow -> Maybe Text
rXmlSchema ColumnRow
r, Just Text
collection <- ColumnRow -> Maybe Text
rXmlCollection ColumnRow
r -> Text -> Text -> TypeArgs
XmlSchemaArg Text
schema Text
collection
      Maybe SqlDataType
_ -> TypeArgs
NoArgs
    -- max_length is in bytes, -1 for (max).
    bytesLength :: Int -> Length
bytesLength Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Length
Max
      | Bool
otherwise = Int -> Length
Length Int
n
    charsLength :: Int -> Length
charsLength Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Length
Max
      | Bool
otherwise = Int -> Length
Length (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)