content: {-# LANGUAGE QuasiQuotes #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  
  {-# HLINT ignore "Use list comprehension" #-}
  {-# HLINT ignore "Replace case with maybe" #-}
  {-# HLINT ignore "Use tuple-section" #-}
  
  module AirGQL.Lib (
    AccessMode (canRead, canWrite, canInsert),
    mkAccessMode,
    readOnly,
    writeOnly,
    insertOnly,
    readAndWrite,
    ColumnEntry (..),
    GqlTypeName (..),
    getEnrichedTable,
    getColumnsFromParsedTableEntry,
    getColumns,
    getRowidColumnName,
    getTables,
    getTableNames,
    getColumnNames,
    getEnrichedTables,
    getPKColumns,
    ObjectType (..),
    parseSql,
    replaceCaseInsensitive,
    sanitizeSql,
    sqlDataToAesonValue,
    sqlDataToText,
    SQLPost (..),
    sqlTypeNameToGQLTypeName,
    TableEntryRaw (..),
    TableEntry (..),
    UniqueConstraint (..),
    ReferencesConstraint (..),
    ReferencesConstraintColumns (..),
    CheckConstraint (..),
    sqlite, -- useful for pretty printing
    stringToGqlTypeName,
    lintTableCreationCode,
    resolveReferencesConstraintColumns,
    resolveReferencesConstraint,
    sqliteErrorToText,
  )
  where
  
  import Protolude (
    Applicative (pure),
    Bool (False, True),
    Either (Left, Right),
    Eq ((/=), (==)),
    Exception (toException),
    Generic,
    IO,
    Int,
    Maybe (Just, Nothing),
    Semigroup ((<>)),
    Show,
    Text,
    notElem,
    otherwise,
    show,
    ($),
    (&),
    (&&),
    (<$>),
    (<&>),
    (>>=),
    (||),
   )
  import Protolude qualified as P
  
  import AirGQL.Utils (collectAllErrorsAsText, quoteText)
  import Control.Monad (MonadFail (fail))
  import Control.Monad.Catch (catchAll)
  import Data.Aeson (FromJSON, ToJSON, Value (Bool, Null, Number, Object, String))
  import Data.Aeson.KeyMap qualified as KeyMap
  import Data.List qualified as List
  import Data.Scientific qualified as Scientific
  import Data.Text (isInfixOf, toUpper)
  import Data.Text qualified as T
  import Database.SQLite.Simple (
    Connection,
    FromRow,
    ResultError (ConversionFailed, errHaskellType, errMessage, errSQLType),
    SQLData (SQLBlob, SQLFloat, SQLInteger, SQLNull, SQLText),
    query_,
   )
  import Database.SQLite.Simple qualified as SS
  import Database.SQLite.Simple.FromField (FromField (fromField), fieldData)
  import Database.SQLite.Simple.Ok (Ok (Errors, Ok))
  import Database.SQLite.Simple.QQ qualified as SS
  import DoubleXEncoding (doubleXEncodeGql)
  import Language.SQL.SimpleSQL.Dialect (
    Dialect (
      diAppKeywords,
      diAutoincrement,
      diBackquotedIden,
      diKeywords,
      diLimit,
      diSquareBracketQuotedIden,
      diWithoutRowidTables
    ),
    ansi2011,
   )
  import Language.SQL.SimpleSQL.Parse (ParseError, parseStatement, prettyError)
  import Language.SQL.SimpleSQL.Pretty (prettyScalarExpr)
  import Language.SQL.SimpleSQL.Syntax (
    ColConstraint (ColCheckConstraint, ColNotNullConstraint),
    ColConstraintDef (ColConstraintDef),
    ColumnDef (ColumnDef),
    InPredValue (InList),
    ScalarExpr (In, NumLit, StringLit),
    Statement (CreateTable),
    TableElement (TableColumnDef),
   )
  import Language.SQL.SimpleSQL.Syntax qualified as SQL
  import Servant.Docs (ToSample (toSamples), singleSample)
  
  
  data AccessMode = AccessMode
    { canRead :: Bool
    , canInsert :: Bool
    , canWrite :: Bool
    }
    deriving (Eq, Show)
  
  
  mkAccessMode :: Bool -> Bool -> Bool -> AccessMode
  mkAccessMode read insert write =
    AccessMode
      { canRead = read
      , canInsert = insert || write
      , canWrite = write
      }
  
  
  readOnly :: AccessMode
  readOnly = mkAccessMode True False False
  
  
  writeOnly :: AccessMode
  writeOnly = mkAccessMode False True True
  
  
  insertOnly :: AccessMode
  insertOnly = mkAccessMode False True False
  
  
  readAndWrite :: AccessMode
  readAndWrite = mkAccessMode True True True
  
  
  data ObjectType = Table | Index | View | Trigger
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON ObjectType
  
  
  instance FromJSON ObjectType
  
  
  instance FromField ObjectType where
    fromField fData = case fieldData fData of
      SQLText "table" -> Ok Table
      SQLText "index" -> Ok Index
      SQLText "view" -> Ok View
      SQLText "trigger" -> Ok Trigger
      sqlData ->
        Errors
          [ toException $
              ConversionFailed
                { errSQLType = "Object Type"
                , errHaskellType = "String"
                , errMessage =
                    "\"" <> show sqlData <> "\" is not a valid object type"
                }
          ]
  
  
  data TableEntryRaw = TableEntryRaw
    { name :: Text
    , tbl_name :: Text
    , object_type :: ObjectType
    , rootpage :: Int
    , sql :: Text
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON TableEntryRaw
  instance FromRow TableEntryRaw
  
  
  data PrimaryKeyConstraint = PrimaryKeyConstraint
    { name :: Maybe Text
    , columns :: [Text]
    }
    deriving (Show, Eq, Generic)
  
  
  data UniqueConstraint = UniqueConstraint
    { name :: Maybe Text
    , columns :: [Text]
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON UniqueConstraint
  
  
  data ReferencesConstraintColumns
    = -- | The "to" column is implicit.
      -- Eg: `a TEXT REFERENCES other_table`
      ImplicitColumns Text
    | -- | Explicit (from, to) pairs
      ExplicitColumns [(Text, Text)]
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON ReferencesConstraintColumns
  
  
  data ReferencesConstraint = ReferencesConstraint
    { name :: Maybe Text
    , table :: Text
    , columns :: ReferencesConstraintColumns
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON ReferencesConstraint
  
  
  data CheckConstraint = CheckConstraint
    { name :: Maybe Text
    , predicate :: Text
    , columns :: Maybe [Text]
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON CheckConstraint
  
  
  data TableEntry = TableEntry
    { name :: Text
    , tbl_name :: Text
    , object_type :: ObjectType
    , rootpage :: Int
    , sql :: Text
    , statement :: Statement
    , uniqueConstraints :: [UniqueConstraint]
    , referencesConstraints :: [ReferencesConstraint]
    , checkConstraints :: [CheckConstraint]
    , primaryKeyConstraints :: [PrimaryKeyConstraint]
    , columns :: [ColumnEntry]
    }
    deriving (Show, Eq, Generic)
  
  
  -- | As requested from SQLite
  data ColumnEntryRaw = ColumnEntryRaw
    { cid :: Int
    , column_name :: Text
    , datatype :: Text
    , notnull :: Int -- TODO: Should be boolean
    , dflt_value :: Maybe Text
    , primary_key :: Int -- TODO: Should be boolean
    , -- See the docs for the different meanings:
      -- https://www.sqlite.org/pragma.html#pragma_table_xinfo
      -- - 0 means normal
      -- - 1 means hidden column in a virtual table
      -- - 2 and 3 mean generated columns
      hidden :: Int
    }
    deriving (Show, Eq, Generic)
  
  
  instance FromRow ColumnEntryRaw
  
  
  data GqlTypeName = GqlTypeName
    { root :: Text
    , full :: Text
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON GqlTypeName
  
  
  -- | Enhanced with generated information from SQL query "CREATE TABLE"
  data ColumnEntry = ColumnEntry
    { column_name :: Text
    , column_name_gql :: Text
    , datatype :: Text
    -- ^ double-X-encoded GQL identifiers
    , datatype_gql :: Maybe GqlTypeName
    , select_options :: Maybe [Text]
    , notnull :: Bool
    , isRowid :: Bool
    , isGenerated :: Bool
    , isUnique :: Bool
    , isOmittable :: Bool
    -- ^ If column is NON NULL, but will be set automatically
    , isReference :: Bool
    -- ^ This will be `true` when the column is part of some REFERENCES constraint.
    , dflt_value :: Maybe Text
    , primary_key :: Bool
    }
    deriving (Show, Eq, Generic)
  
  
  instance ToJSON ColumnEntry
  
  
  data ParsedTable = ParsedTable
    { uniqueConstraints :: [UniqueConstraint]
    , referencesConstraints :: [ReferencesConstraint]
    , checkConstraints :: [CheckConstraint]
    , primaryKeyConstraints :: [PrimaryKeyConstraint]
    , statement :: Statement
    }
    deriving (Show, Eq, Generic)
  
  
  getTables :: Connection -> IO [TableEntryRaw]
  getTables connection = do
    query_
      connection
      [SS.sql|
        SELECT name, tbl_name, type, rootpage, sql
        FROM sqlite_master
        WHERE
          type == 'table' OR
          type == 'view'
      |]
      :: IO [TableEntryRaw]
  
  
  getTableNames :: Connection -> IO [Text]
  getTableNames connection = do
    results :: [SS.Only Text] <-
      query_
        connection
        [SS.sql|
          SELECT tbl_name
          FROM sqlite_master
          WHERE type='table' or type='view'
        |]
  
    pure (SS.fromOnly <$> results)
  
  
  getColumnNames :: Connection -> Text -> IO [Text]
  getColumnNames connection tableName = do
    results :: [SS.Only Text] <-
      SS.query
        connection
        "SELECT name FROM pragma_table_xinfo(?)"
        [tableName]
    pure (SS.fromOnly <$> results)
  
  
  -- TODO: investigate whether we ever want to quote the result
  nameAsText :: SQL.Name -> Text
  nameAsText = \case
    SQL.Name _ name -> name
  
  
  getFirstName :: Maybe [SQL.Name] -> Maybe Text
  getFirstName namesMb = do
    names <- namesMb
    first <- P.head names
    pure (nameAsText first)
  
  
  getColumnUniqueConstraint
    :: Text
    -> SQL.ColConstraintDef
    -> Maybe UniqueConstraint
  getColumnUniqueConstraint col_name = \case
    SQL.ColConstraintDef names SQL.ColUniqueConstraint ->
      Just $
        UniqueConstraint
          { name = getFirstName names
          , columns = [col_name]
          }
    _ -> Nothing
  
  
  tableUniqueConstraints :: SQL.TableElement -> [UniqueConstraint]
  tableUniqueConstraints = \case
    SQL.TableConstraintDef names (SQL.TableUniqueConstraint columns) ->
      [ UniqueConstraint
          { name = getFirstName names
          , columns = P.fmap nameAsText columns
          }
      ]
    SQL.TableColumnDef (SQL.ColumnDef col_name _ constraints) ->
      P.mapMaybe (getColumnUniqueConstraint (nameAsText col_name)) constraints
    _ -> []
  
  
  getColumnPKConstraint
    :: Text
    -> SQL.ColConstraintDef
    -> Maybe PrimaryKeyConstraint
  getColumnPKConstraint col_name = \case
    SQL.ColConstraintDef names (SQL.ColPrimaryKeyConstraint _) ->
      Just $
        PrimaryKeyConstraint
          { name = getFirstName names
          , columns = [col_name]
          }
    _ -> Nothing
  
  
  tablePKConstraints :: SQL.TableElement -> [PrimaryKeyConstraint]
  tablePKConstraints = \case
    SQL.TableConstraintDef names (SQL.TablePrimaryKeyConstraint columns) ->
      [ PrimaryKeyConstraint
          { name = getFirstName names
          , columns = P.fmap nameAsText columns
          }
      ]
    SQL.TableColumnDef (SQL.ColumnDef col_name _ constraints) ->
      P.mapMaybe (getColumnPKConstraint (nameAsText col_name)) constraints
    _ -> []
  
  
  pkConstraintToUniqueConstraint :: PrimaryKeyConstraint -> UniqueConstraint
  pkConstraintToUniqueConstraint pk =
    UniqueConstraint
      { name = pk.name
      , columns = pk.columns
      }
  
  
  getColumnCheckConstraint
    :: Text
    -> SQL.ColConstraintDef
    -> Maybe CheckConstraint
  getColumnCheckConstraint col_name = \case
    SQL.ColConstraintDef names (SQL.ColCheckConstraint expr) ->
      Just $
        CheckConstraint
          { name = getFirstName names
          , columns = Just [col_name]
          , predicate = prettyScalarExpr sqlite expr
          }
    _ -> Nothing
  
  
  tableCheckConstraints :: SQL.TableElement -> [CheckConstraint]
  tableCheckConstraints = \case
    SQL.TableConstraintDef names (SQL.TableCheckConstraint expr) ->
      [ CheckConstraint
          { name = getFirstName names
          , predicate = prettyScalarExpr sqlite expr
          , -- not sure how to do this properly
            columns = Nothing
          }
      ]
    SQL.TableColumnDef (SQL.ColumnDef col_name _ constraints) ->
      P.mapMaybe (getColumnCheckConstraint (nameAsText col_name)) constraints
    _ -> []
  
  
  getColumnReferencesConstraint
    :: Text
    -> SQL.ColConstraintDef
    -> P.Either Text (Maybe ReferencesConstraint)
  getColumnReferencesConstraint col_name = \case
    SQL.ColConstraintDef
      names
      (SQL.ColReferencesConstraint table_names foreign_col_name _ _ _) -> do
        table_name <-
          P.note "Column references constraint has no table name" $
            P.head table_names
  
        pure $
          Just $
            ReferencesConstraint
              { name = getFirstName names
              , table = nameAsText table_name
              , columns = case foreign_col_name of
                  Just explicit_col_name ->
                    ExplicitColumns [(col_name, nameAsText explicit_col_name)]
                  Nothing ->
                    ImplicitColumns col_name
              }
    _ -> pure Nothing
  
  
  tableReferencesConstraints
    :: SQL.TableElement
    -> P.Either Text [ReferencesConstraint]
  tableReferencesConstraints = \case
    SQL.TableConstraintDef
      names
      ( SQL.TableReferencesConstraint
          self_columns
          table_names
          foreign_columns
          _
          _
          _
        ) -> do
        table_name <-
          P.note "Table references constraint has no table name" $
            P.head table_names
  
        columns <- case (self_columns, foreign_columns) of
          ([column], Nothing) ->
            pure $ ImplicitColumns (nameAsText column)
          (_, Nothing) ->
            P.throwError
              "References constraints where more than one column is \
              \implicit are not supported"
          (columns, Just many_foreign_columns) -> do
            P.when (P.length columns /= P.length many_foreign_columns) $ do
              P.throwError
                "Number of columns in references constraint \
                \must be equal"
  
            pure $
              ExplicitColumns $
                P.zip
                  (P.fmap nameAsText columns)
                  (P.fmap nameAsText many_foreign_columns)
  
        pure
          [ ReferencesConstraint
              { name = getFirstName names
              , table = nameAsText table_name
              , columns = columns
              }
          ]
    SQL.TableColumnDef (SQL.ColumnDef col_name _ constraints) ->
      -- => [ColumnConstraint]
      constraints
        -- => [Either Text (Maybe ColumnConstraint)]
        <&> getColumnReferencesConstraint (nameAsText col_name)
        -- => Either Text [Maybe ColumnConstraint]
        & collectAllErrorsAsText
        -- => Either Text [ColumnConstraint]
        <&> P.catMaybes
    _ -> pure []
  
  
  getTableUniqueIndexConstraints :: SS.Connection -> Text -> IO [UniqueConstraint]
  getTableUniqueIndexConstraints connection tableName = do
    indices :: [[SQLData]] <-
      catchAll
        ( SS.query
            connection
            [SS.sql|
              SELECT sql
              FROM sqlite_master
              WHERE tbl_name = ? AND type = 'index'
            |]
            [tableName]
        )
        (\_ -> pure [])
  
    indices
      <&> \case
        [SQLText sqlTxt]
          -- Get column name from SQL query
          | P.Right (SQL.CreateIndex True indexNames _ columns) <-
              parseSql sqlTxt -> do
              Just $
                UniqueConstraint
                  { name = nameAsText <$> P.head indexNames
                  , columns = nameAsText <$> columns
                  }
        _ -> Nothing
      & P.catMaybes
      & pure
  
  
  getSqlObjectName :: Statement -> Maybe Text
  getSqlObjectName = \case
    SQL.CreateTable names _ _ ->
      names
        & P.head
        <&> nameAsText
    SQL.CreateView _ _ names _ _ ->
      names
        >>= P.head
          <&> nameAsText
    _ -> Nothing
  
  
  {-| Collects the different kinds of constraints found in a sql statement.
  
  An optional connection can be used to read existing indices for unique
  constraints of columns added after table creation.
  -}
  collectTableConstraints
    :: Maybe SS.Connection
    -> Statement
    -> IO (P.Either Text ParsedTable)
  collectTableConstraints connectionMb statement = do
    uniqueIndices <- case (connectionMb, getSqlObjectName statement) of
      (Just conn, Just name) -> getTableUniqueIndexConstraints conn name
      _ -> pure []
    case statement of
      CreateTable _ elements _ -> do
        let referencesConstraintsEither =
              -- => [TableElemenet]
              elements
                -- =>  [Either Text TableElemenet]
                & P.fmap tableReferencesConstraints
                -- =>  Either Text [[TableElemenet]]
                & collectAllErrorsAsText
                -- =>  Either Text [TableElemenet]
                & P.fmap P.join
  
        let pkConstraints = elements >>= tablePKConstraints
        let uniqueConstraints =
              uniqueIndices
                <> (elements >>= tableUniqueConstraints)
                -- Primary keys are unique by default,
                -- even though they do not have an unique index
                <> (pkConstraints <&> pkConstraintToUniqueConstraint)
  
        P.for referencesConstraintsEither $ \referencesConstraints -> do
          pure $
            ParsedTable
              { uniqueConstraints = uniqueConstraints
              , referencesConstraints = referencesConstraints
              , checkConstraints = elements >>= tableCheckConstraints
              , primaryKeyConstraints = pkConstraints
              , statement = statement
              }
      _ ->
        pure $
          P.Right $
            ParsedTable
              { uniqueConstraints = uniqueIndices
              , referencesConstraints = []
              , checkConstraints = []
              , primaryKeyConstraints = []
              , statement = statement
              }
  
  
  enrichTableEntry
    :: SS.Connection
    -> TableEntryRaw
    -> IO (P.Either Text TableEntry)
  enrichTableEntry connection tableEntry@(TableEntryRaw{..}) =
    case parseSql tableEntry.sql of
      P.Left err -> pure $ P.Left (prettyError err)
      P.Right sqlStatement ->
        collectTableConstraints (Just connection) sqlStatement
          <&> P.fmap
            ( \(ParsedTable{..}) ->
                TableEntry{columns = [], ..}
            )
  
  
  getEnrichedTables :: Connection -> IO (P.Either Text [TableEntry])
  getEnrichedTables connection = do
    tables <- getTables connection
    enriched <- P.for tables $ \table -> do
      enrichedEither <- enrichTableEntry connection table
      P.for enrichedEither $ \enriched@TableEntry{..} -> do
        tableColumns <-
          getColumnsFromParsedTableEntry
            connection
            enriched
        pure $
          TableEntry
            { columns = tableColumns
            , ..
            }
    pure $ collectAllErrorsAsText enriched
  
  
  {-| SQLite allows references constraints to not specify the exact column they
  are referencing. This functions tries to recover that information by
  looking for primary keys among the columns of the referenced table.
  -}
  resolveReferencesConstraint :: [TableEntry] -> Text -> Maybe Text
  resolveReferencesConstraint tables referencedTable = do
    table <-
      P.find
        (\table -> table.tbl_name == referencedTable)
        tables
    let columns = table.columns
    let pks = P.filter (\column -> column.primary_key) columns
    let nonRowidPks = P.filter (\column -> P.not column.isRowid) pks
    column <- case nonRowidPks of
      [] -> P.find (\column -> column.isRowid) pks
      [column] -> pure column
      -- Note: we currently do not support having composite primary keys
      -- referenced implicitly, as that would lead to multiple complications like:
      -- - figuring out the correct order for the references
      -- - having to perform the "enrichTableEntry" computation in two separate passes
      --
      -- Note 2: Is this that hard to handle? I think there's a good chance we could
      -- do it as long as we keep track of the column order. Not sure it's worth the
      -- hassle though...
      _ -> Nothing
    pure column.column_name
  
  
  --  See the docs for `resolveReferencesConstraint` for details
  resolveReferencesConstraintColumns
    :: [TableEntry]
    -> ReferencesConstraint
    -> Maybe [(Text, Text)]
  resolveReferencesConstraintColumns allEntries constraint =
    case constraint.columns of
      ExplicitColumns explicit -> Just explicit
      ImplicitColumns from ->
        case resolveReferencesConstraint allEntries constraint.table of
          Just to -> Just [(from, to)]
          Nothing -> Nothing
  
  
  -- | Returns a set of warnings related to a given table.
  lintTable :: [TableEntry] -> ParsedTable -> [Text]
  lintTable allEntries parsed =
    let
      rowidReferenceWarnings =
        parsed.referencesConstraints
          & P.mapMaybe
            ( \constraint ->
                resolveReferencesConstraintColumns allEntries constraint
                  & P.fromMaybe []
                  & P.find (\(_, to) -> to == "rowid")
                  <&> \case
                    (from, _to) ->
                      "Column "
                        <> quoteText from
                        <> " references the rowid column of table "
                        <> quoteText constraint.table
                        <> ".\n"
                        <> "This is not supported by SQLite:\n"
                        <> "https://www.sqlite.org/foreignkeys.html"
            )
  
      withoutRowidWarning = case parsed.statement of
        CreateTable names _ True
          | Just name <- getFirstName (Just names) ->
              pure $
                "Table "
                  <> quoteText name
                  <> " does not have a rowid column. "
                  <> "Such tables are not currently supported by Airsequel."
        _ -> []
    in
      rowidReferenceWarnings <> withoutRowidWarning
  
  
  {-| Lint the sql code for creating a table
  
  An optional connection can be used to retrieve the existing db data, which
  is used for things like resolving implicit references constraints (where
  the primary key is not explicitly given).
  
  The connection is optional to allow calling this function on-the-fly when
  creating the initial table in a databse.
  -}
  lintTableCreationCode :: Maybe SS.Connection -> Statement -> IO [Text]
  lintTableCreationCode connectionMb statement = do
    constraintsEither <- collectTableConstraints connectionMb statement
    allEntriesEither <- case connectionMb of
      Just connection -> getEnrichedTables connection
      Nothing -> pure $ Right []
    pure $ case (constraintsEither, allEntriesEither) of
      (Right _, Left err) -> [err]
      (Left err, Right _) -> [err]
      (Left errL, Left errR) -> [errL, errR]
      (Right parsed, Right allEntries) ->
        lintTable allEntries parsed
  
  
  getRowidColumnName :: [Text] -> Text
  getRowidColumnName colNames
    | "rowid" `notElem` colNames = "rowid"
    | "_rowid_" `notElem` colNames = "_rowid_"
    | "oid" `notElem` colNames = "oid"
    | otherwise = "rowid" -- TODO: Return error to user
  
  
  {-| Select the column(s) that form this table's primary key. If no non-rowid
  columns are marked as part of a PK constraint, the rowid column will be
  returned instead.
  -}
  getPKColumns :: TableEntry -> Maybe [ColumnEntry]
  getPKColumns table = do
    let pks = List.filter (\col -> col.primary_key) table.columns
  
    -- We filter out the rowid column, unless it is the only one
    case pks of
      [] -> Nothing
      [first] | first.isRowid -> Just [first]
      _ -> Just $ List.filter (\col -> P.not col.isRowid) pks
  
  
  columnDefName :: ColumnDef -> Text
  columnDefName (ColumnDef name _ _) = nameAsText name
  
  
  -- Computes whether a column is NOT NULL
  columnIsNonNull :: SQL.ColumnDef -> Bool
  columnIsNonNull (ColumnDef _ _ constraints) =
    let isNotNullConstraint = \case
          ColConstraintDef _ ColNotNullConstraint -> True
          _ -> False
    in  P.any isNotNullConstraint constraints
  
  
  -- For a single column, returns selectable values
  -- E.g. ("color", (SelectOptions ["red", "green", "blue"]))
  columnSelectOptions :: SQL.ColumnDef -> Maybe SelectOptions
  columnSelectOptions (ColumnDef _ _ colConstraints) =
    let
      getSelectOptions
        :: ColConstraintDef
        -> Maybe SelectOptions
      getSelectOptions = \case
        ColConstraintDef
          _
          (ColCheckConstraint (In _ _ (InList options))) ->
            let
              textOnlyOptions =
                options
                  <&> \case
                    StringLit _ _ value -> value
                    NumLit value -> value
                    _ -> "UNSUPPORTED"
            in
              Just (SelectOptions textOnlyOptions)
        _ -> Nothing
    in
      colConstraints
        & P.mapMaybe getSelectOptions
        & P.head
  
  
  getColumnsFromParsedTableEntry
    :: Connection
    -> TableEntry
    -> IO [ColumnEntry]
  getColumnsFromParsedTableEntry connection tableEntry = do
    keyColumns :: [[SQLData]] <-
      SS.query
        connection
        "SELECT * FROM pragma_index_info(?)"
        [tableEntry.tbl_name]
  
    -- TODO: Catch only SQL specific exceptions
    colEntriesRaw :: [ColumnEntryRaw] <-
      catchAll
        ( SS.query
            connection
            "SELECT * FROM pragma_table_xinfo(?)"
            [tableEntry.tbl_name]
        )
        ( \exception -> do
            P.putErrText $ show exception
            pure []
        )
  
    let
      tableElementsMb = case tableEntry.statement of
        SQL.CreateTable _ tableElements _ ->
          Just tableElements
        _ -> Nothing
  
      columnDefs = case tableElementsMb of
        Just tableElements ->
          tableElements
            <&> \case
              TableColumnDef columnDef -> Just columnDef
              _ -> Nothing
            & P.catMaybes
        Nothing -> []
  
      -- As described here: https://www.sqlite.org/withoutrowid.html (Point 5)
      hasRowId :: Bool
      hasRowId = P.null keyColumns
  
      colNames :: [Text]
      colNames = colEntriesRaw <&> \c -> c.column_name
  
      rowIdColName :: Text
      rowIdColName = getRowidColumnName colNames
  
      rowIdColumnEntry :: ColumnEntry
      rowIdColumnEntry =
        ColumnEntry
          { column_name = rowIdColName
          , column_name_gql = rowIdColName
          , datatype = "INTEGER"
          , datatype_gql = Just $ stringToGqlTypeName "Int"
          , select_options = P.Nothing
          , notnull = True
          , isUnique = True
          , isOmittable = True
          , isGenerated = False
          , dflt_value = P.Nothing
          , primary_key = True
          , isReference = False
          , isRowid = True
          }
  
    let
      entries =
        colEntriesRaw <&> \(ColumnEntryRaw{..}) -> do
          let
            columnDefMb = P.find (\d -> columnDefName d == column_name) columnDefs
            selectOpts = columnDefMb >>= columnSelectOptions
            isNotNull =
              notnull == 1 || primary_key == 1 || case columnDefMb of
                Just columnDef -> columnIsNonNull columnDef
                Nothing -> False
  
          ColumnEntry
            { column_name_gql = doubleXEncodeGql column_name
            , datatype_gql =
                sqlTypeNameToGQLTypeName
                  datatype
                  ( P.const
                      (tableEntry.tbl_name <> "_" <> column_name)
                      <$> selectOpts
                  )
            , select_options = selectOpts <&> unSelectOptions
            , isUnique =
                P.any
                  (\constraint -> column_name `P.elem` constraint.columns)
                  tableEntry.uniqueConstraints
            , primary_key =
                primary_key == 1
                  || P.any
                    (\constraint -> column_name `P.elem` constraint.columns)
                    tableEntry.primaryKeyConstraints
            , isOmittable =
                (primary_key == 1 && T.isPrefixOf "int" (T.toLower datatype))
                  || P.isJust dflt_value
                  || P.not isNotNull
            , notnull = isNotNull
            , -- See the comment on the `hidden` property of
              -- the `ColumnEntryRaw` type for an explanation.
              isGenerated = hidden == 2 || hidden == 3
            , isReference =
                tableEntry.referencesConstraints
                  & P.any
                    ( \constraint -> case constraint.columns of
                        ImplicitColumns from -> from == column_name
                        ExplicitColumns columns ->
                          columns
                            & P.any (\(from, _) -> from == column_name)
                    )
            , isRowid = False
            , ..
            }
      -- Views don't have a rowid column
      -- (https://stackoverflow.com/q/38519169)
      rowidColumns =
        if hasRowId && tableEntry.object_type /= View
          then [rowIdColumnEntry]
          else []
  
    pure $ rowidColumns <> entries
  
  
  getEnrichedTable :: Text -> Connection -> Text -> IO TableEntry
  getEnrichedTable dbId connection tableName = do
    tables :: [TableEntryRaw] <-
      SS.query
        connection
        [SS.sql|
          SELECT name, tbl_name, type, rootpage, sql
          FROM sqlite_master
          WHERE name == ?
        |]
        [tableName]
  
    table <- case P.head tables of
      Just table -> pure table
      Nothing ->
        fail $
          P.fold
            [ "Could not find table info for table "
            , T.unpack tableName
            , " of db "
            , T.unpack dbId
            ]
  
    enrichmentResultEither <- enrichTableEntry connection table
    case enrichmentResultEither of
      Right result -> pure result
      Left err ->
        fail $
          P.fold
            [ "An error occurred while parsing table "
            , T.unpack tableName
            , " of db "
            , T.unpack dbId
            , ": "
            , T.unpack err
            ]
  
  
  getColumns :: Text -> Connection -> Text -> IO [ColumnEntry]
  getColumns dbId conn tableName =
    let columns = do
          enrichingResult <- getEnrichedTable dbId conn tableName
          getColumnsFromParsedTableEntry conn enrichingResult
    in  catchAll
          columns
          $ \err -> do
            P.putErrText $ P.show err
            pure []
  
  
  newtype SelectOptions = SelectOptions {unSelectOptions :: [Text]}
    deriving (Show, Eq, Generic)
  
  
  stringToGqlTypeName :: Text -> GqlTypeName
  stringToGqlTypeName name = GqlTypeName{full = name, root = name}
  
  
  {-| Computes storage class through type affinity
    as described in https://www.sqlite.org/datatype3.html#affname
    with an extension for boolean (Order is important)
    TODO: Add Support for GraphQL's type "ID"
  -}
  sqlTypeNameToGQLTypeName :: Text -> Maybe Text -> Maybe GqlTypeName
  sqlTypeNameToGQLTypeName sqliteType typeNameMb =
    let
      containsText text =
        isInfixOf text $ toUpper sqliteType
  
      rootType
        -- If it is a view, column might not have a type
        | sqliteType == "" = Nothing
        | containsText "INT" = Just "Int"
        | containsText "CHAR" || containsText "CLOB" || containsText "TEXT" =
            Just "String"
        | containsText "BLOB" = Just "String"
        | containsText "REAL" || containsText "FLOA" || containsText "DOUB" =
            Just "Float"
        | containsText "BOOL" = Just "Boolean"
        | otherwise = Just "Int"
    in
      rootType <&> \root ->
        GqlTypeName
          { root = root
          , full = case typeNameMb of
              P.Just typeName -> doubleXEncodeGql (typeName <> "_" <> root)
              P.Nothing -> root
          }
  
  
  sqlDataToText :: SQLData -> Text
  sqlDataToText = \case
    SQLInteger int64 -> show int64
    SQLFloat double -> show double
    SQLText text -> text
    SQLBlob _ -> "BLOB"
    SQLNull -> "NULL"
  
  
  -- | WARNING: Also change duplicate `sqlDataToGQLValue`
  sqlDataToAesonValue :: Text -> SQLData -> Value
  sqlDataToAesonValue datatype sqlData = case sqlData of
    SQLInteger int64 ->
      if isInfixOf "BOOL" $ toUpper datatype
        then case int64 of
          0 -> Bool False
          _ -> Bool True
        else Number $ P.fromIntegral int64 -- Int32
    SQLFloat double -> Number $ Scientific.fromFloatDigits double
    SQLText text -> String text
    SQLBlob _ -> Object $ KeyMap.singleton "type" "blob"
    SQLNull -> Null
  
  
  {-| Case-insensitively replaces all occurrences of a substring within a string
    with a replacement string.
  
    Examples:
  
    >>> replaceCaseInsensitive "hello" "hi" "Hello World"
    "hi World"
  
    >>> replaceCaseInsensitive "l" "L" "Hello World"
    "HeLLo WorLd"
  -}
  replaceCaseInsensitive :: Text -> Text -> Text -> Text
  replaceCaseInsensitive removable replacement txt =
    let
      len = T.length removable
      process remaining result
        | T.null remaining = result
        | (remaining & T.take len & T.toLower) == (removable & T.toLower) =
            process (remaining & T.drop len) (result <> replacement)
        | otherwise =
            process (remaining & T.drop 1) (result <> T.take 1 remaining)
    in
      process txt ""
  
  
  {-| Replace rem(movable) with rep(lacement)
  | and make sure its surrounded by spaces
  -}
  replaceWithSpace :: Text -> Text -> Text -> Text
  replaceWithSpace rem rep txt =
    txt
      & replaceCaseInsensitive (" " <> rem <> " ") (" " <> rep <> " ")
      & replaceCaseInsensitive (" " <> rem <> "\n") (" " <> rep <> "\n")
      & replaceCaseInsensitive ("\n" <> rem <> " ") ("\n" <> rep <> " ")
      & replaceCaseInsensitive ("\n" <> rem <> "\n") ("\n" <> rep <> "\n")
  
  
  sanitizeSql :: Text -> Text
  sanitizeSql sql =
    sql
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/27
      & replaceWithSpace "if not exists" ""
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/37
      & replaceCaseInsensitive "insert or abort " "insert "
      & replaceCaseInsensitive "insert or fail " "insert "
      & replaceCaseInsensitive "insert or ignore " "insert "
      & replaceCaseInsensitive "insert or replace " "insert "
      & replaceCaseInsensitive "insert or rollback " "insert "
      -- Removing the JSON arrow operator seems to be enough
      -- to make the parser accept all queries containing JSON operators
      & T.replace "->" ""
      -- https://www.sqlite.org/stricttables.html
      & replaceCaseInsensitive ")strict" ")"
      & replaceCaseInsensitive ") strict" ")"
      & replaceCaseInsensitive ")\nstrict" ")"
      & replaceCaseInsensitive ") \nstrict" ")"
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/20
      & ( \sqlQuery ->
            if P.all
              (\word -> word `P.elem` T.words (T.toLower sqlQuery))
              ["alter", "table", "rename"]
              then "SELECT 0" -- Dummy statement to accept the query
              else sqlQuery
        )
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/41
      & ( \sqlQuery ->
            if P.all
              (\word -> word `P.elem` T.words (T.toLower sqlQuery))
              ["create", "trigger", "on", "begin", "end"]
              then "SELECT 0" -- Dummy statement to accept the query
              else sqlQuery
        )
      & replaceCaseInsensitive "drop trigger" "drop table"
      & replaceCaseInsensitive "drop index" "drop table"
      -- Uncomment unsupported "RETURNING" clause
      -- TODO: Add support for DELETE and UPDATE with RETURNING
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/42
      & replaceCaseInsensitive ")returning " ") -- returning "
      & replaceCaseInsensitive ") returning " ") -- returning "
      & replaceCaseInsensitive ")\nreturning " ")\n-- returning "
      & replaceCaseInsensitive ") \nreturning " ")\n-- returning "
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/43
      & replaceWithSpace "==" "="
      & replaceWithSpace "is not" "%$@_TEMP_@$%"
      & replaceWithSpace "is" "="
      & replaceWithSpace "%$@_TEMP_@$%" "is not"
      -- The internal table is created without column types
      -- TODO: Remove after
      -- https://github.com/JakeWheat/simple-sql-parser/issues/38#issuecomment-1413340116
      & replaceCaseInsensitive
        "sqlite_sequence(name,seq)"
        "sqlite_sequence(name TEXT,seq INT)"
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/40
      & replaceWithSpace "NOT NULL DEFAULT" "DEFAULT"
      -- TODO: Remove after
      --       https://github.com/JakeWheat/simple-sql-parser/issues/46
      & replaceCaseInsensitive "STORED" ""
      & replaceCaseInsensitive "VIRTUAL" ""
      & replaceWithSpace "GLOB" "LIKE"
  
  
  -- | SQLite dialect
  sqlite :: Dialect
  sqlite =
    ansi2011
      { diLimit = True
      , diAutoincrement = True
      , diAppKeywords =
          ansi2011.diAppKeywords
            <> [ "abs"
               , -- https://www.sqlite.org/lang_mathfunc.html
                 "acos"
               , "acosh"
               , "asin"
               , "asinh"
               , "atan"
               , "atan2"
               , "atanh"
               , "ceil"
               , "ceiling"
               , "cos"
               , "cosh"
               , "degrees"
               , "exp"
               , "floor"
               , "ln"
               , "log"
               , "log"
               , "log10"
               , "log2"
               , "mod"
               , "pi"
               , "pow"
               , "power"
               , "radians"
               , "sin"
               , "sinh"
               , "sqrt"
               , "tan"
               , "tanh"
               , "trunc"
               ]
      , diKeywords =
          [ "abort"
          , "action"
          , "add"
          , "after"
          , "all"
          , "alter"
          , "always"
          , "analyze"
          , "and"
          , "as"
          , "asc"
          , "attach"
          , "autoincrement"
          , "before"
          , "begin"
          , "between"
          , "by"
          , "cascade"
          , "case"
          , "cast"
          , "check"
          , "collate"
          , "column"
          , "commit"
          , "conflict"
          , "constraint"
          , "create"
          , "cross"
          , "current"
          , "database"
          , "default"
          , "deferrable"
          , "deferred"
          , "delete"
          , "desc"
          , "detach"
          , "distinct"
          , "do"
          , "drop"
          , "each"
          , "else"
          , "end"
          , "escape"
          , "except"
          , "exclude"
          , "exclusive"
          , "exists"
          , "explain"
          , "fail"
          , "filter"
          , "first"
          , "following"
          , "for"
          , "foreign"
          , "from"
          , "full"
          , "generated"
          , "glob"
          , "group"
          , "groups"
          , "having"
          , "if"
          , "ignore"
          , "immediate"
          , "in"
          , "index"
          , "indexed"
          , "initially"
          , "inner"
          , "insert"
          , "instead"
          , "intersect"
          , "into"
          , "is"
          , "isnull"
          , "join"
          , "key"
          , "last"
          , "left"
          , "like"
          , "limit"
          , "match"
          , "materialized"
          , "natural"
          , "no"
          , "not"
          , "nothing"
          , "notnull"
          , -- although "null" is on the official list of keywords, adding it here
            --  seems to break "select NULL as ..." statements
            -- , "null"
            "nulls"
          , "of"
          , "offset"
          , "on"
          , "or"
          , "order"
          , "others"
          , "outer"
          , "over"
          , "partition"
          , "plan"
          , "pragma"
          , "preceding"
          , "primary"
          , "query"
          , "raise"
          , "range"
          , "recursive"
          , "references"
          , "regexp"
          , "reindex"
          , "release"
          , "rename"
          , "replace"
          , "restrict"
          , "returning"
          , "right"
          , "rollback"
          , "row"
          , "rows"
          , "savepoint"
          , "select"
          , "set"
          , "table"
          , "temp"
          , "temporary"
          , "then"
          , "ties"
          , "to"
          , "transaction"
          , "trigger"
          , "unbounded"
          , "union"
          , "unique"
          , "update"
          , "using"
          , "vacuum"
          , "values"
          , "view"
          , "virtual"
          , "when"
          , "where"
          , "window"
          , "with"
          , "without"
          ]
      , diBackquotedIden = True -- https://sqlite.org/lang_keywords.html
      , diSquareBracketQuotedIden = True -- https://sqlite.org/lang_keywords.html
      , diWithoutRowidTables = True -- https://www.sqlite.org/withoutrowid.html
      }
  
  
  parseSql :: Text -> P.Either ParseError Statement
  parseSql sqlQuery =
    parseStatement sqlite "" P.Nothing $ sanitizeSql sqlQuery
  
  
  newtype SQLPost = SQLPost
    { query :: Text
    }
    deriving (Eq, Show, Generic)
  
  
  instance ToJSON SQLPost
  instance FromJSON SQLPost
  
  
  instance ToSample AirGQL.Lib.SQLPost where
    toSamples _ = singleSample $ SQLPost "SELECT * FROM users"
  
  
  -- | Converts a SQL error to text, possibly adding airsequel-specific context.
  sqliteErrorToText :: SS.SQLError -> Text
  sqliteErrorToText error =
    let
      addendum = case SS.sqlErrorDetails error of
        "database or disk is full" ->
          Just $
            "This might be caused by the database exceeding "
              <> "the maximum page count for your current plan."
        _ -> Nothing
    in
      show error <> case addendum of
        Nothing -> ""
        Just text -> "\n" <> text
  