{-# 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 (..),
  ColumnEntry (..),
  GqlTypeName (..),
  getColumns,
  getRowidColumnName,
  getTables,
  getTableNames,
  getColumnNames,
  getEnrichedTables,
  ObjectType (..),
  parseSql,
  replaceCaseInsensitive,
  sanitizeSql,
  sqlDataToAesonValue,
  sqlDataToText,
  SQLPost (..),
  sqlTypeNameToGQLTypeName,
  TableEntryRaw (..),
  TableEntry (..),
  UniqueConstraint (..),
  ReferencesConstraint (..),
  ReferencesConstraintColumns (..),
  CheckConstraint (..),
  sqlite, -- useful for pretty printing
  stringToGqlTypeName,
  lintTableCreationCode,
  resolveReferencesConstraintColumns,
  resolveReferencesConstraint,
)
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, String))
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
  ),
  ansi2011,
 )
import Language.SQL.SimpleSQL.Parse (ParseError, parseStatement)
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 = ReadOnly | WriteOnly | ReadAndWrite
  deriving (AccessMode -> AccessMode -> Bool
(AccessMode -> AccessMode -> Bool)
-> (AccessMode -> AccessMode -> Bool) -> Eq AccessMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccessMode -> AccessMode -> Bool
== :: AccessMode -> AccessMode -> Bool
$c/= :: AccessMode -> AccessMode -> Bool
/= :: AccessMode -> AccessMode -> Bool
Eq, Int -> AccessMode -> ShowS
[AccessMode] -> ShowS
AccessMode -> String
(Int -> AccessMode -> ShowS)
-> (AccessMode -> String)
-> ([AccessMode] -> ShowS)
-> Show AccessMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccessMode -> ShowS
showsPrec :: Int -> AccessMode -> ShowS
$cshow :: AccessMode -> String
show :: AccessMode -> String
$cshowList :: [AccessMode] -> ShowS
showList :: [AccessMode] -> ShowS
Show)


data ObjectType = Table | Index | View | Trigger
  deriving (Int -> ObjectType -> ShowS
[ObjectType] -> ShowS
ObjectType -> String
(Int -> ObjectType -> ShowS)
-> (ObjectType -> String)
-> ([ObjectType] -> ShowS)
-> Show ObjectType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectType -> ShowS
showsPrec :: Int -> ObjectType -> ShowS
$cshow :: ObjectType -> String
show :: ObjectType -> String
$cshowList :: [ObjectType] -> ShowS
showList :: [ObjectType] -> ShowS
Show, ObjectType -> ObjectType -> Bool
(ObjectType -> ObjectType -> Bool)
-> (ObjectType -> ObjectType -> Bool) -> Eq ObjectType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectType -> ObjectType -> Bool
== :: ObjectType -> ObjectType -> Bool
$c/= :: ObjectType -> ObjectType -> Bool
/= :: ObjectType -> ObjectType -> Bool
Eq, (forall x. ObjectType -> Rep ObjectType x)
-> (forall x. Rep ObjectType x -> ObjectType) -> Generic ObjectType
forall x. Rep ObjectType x -> ObjectType
forall x. ObjectType -> Rep ObjectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectType -> Rep ObjectType x
from :: forall x. ObjectType -> Rep ObjectType x
$cto :: forall x. Rep ObjectType x -> ObjectType
to :: forall x. Rep ObjectType x -> ObjectType
Generic)


instance ToJSON ObjectType


instance FromJSON ObjectType


instance FromField ObjectType where
  fromField :: FieldParser ObjectType
fromField Field
fData = case Field -> SQLData
fieldData Field
fData of
    SQLText Text
"table" -> ObjectType -> Ok ObjectType
forall a. a -> Ok a
Ok ObjectType
Table
    SQLText Text
"index" -> ObjectType -> Ok ObjectType
forall a. a -> Ok a
Ok ObjectType
Index
    SQLText Text
"view" -> ObjectType -> Ok ObjectType
forall a. a -> Ok a
Ok ObjectType
View
    SQLText Text
"trigger" -> ObjectType -> Ok ObjectType
forall a. a -> Ok a
Ok ObjectType
Trigger
    SQLData
sqlData ->
      [SomeException] -> Ok ObjectType
forall a. [SomeException] -> Ok a
Errors
        [ ResultError -> SomeException
forall e. Exception e => e -> SomeException
toException (ResultError -> SomeException) -> ResultError -> SomeException
forall a b. (a -> b) -> a -> b
$
            ConversionFailed
              { errSQLType :: String
errSQLType = String
"Object Type"
              , errHaskellType :: String
errHaskellType = String
"String"
              , errMessage :: String
errMessage =
                  String
"\"" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SQLData -> String
forall a b. (Show a, StringConv String b) => a -> b
show SQLData
sqlData String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"\" is not a valid object type"
              }
        ]


data TableEntryRaw = TableEntryRaw
  { TableEntryRaw -> Text
name :: Text
  , TableEntryRaw -> Text
tbl_name :: Text
  , TableEntryRaw -> ObjectType
object_type :: ObjectType
  , TableEntryRaw -> Int
rootpage :: Int
  , TableEntryRaw -> Text
sql :: Text
  }
  deriving (Int -> TableEntryRaw -> ShowS
[TableEntryRaw] -> ShowS
TableEntryRaw -> String
(Int -> TableEntryRaw -> ShowS)
-> (TableEntryRaw -> String)
-> ([TableEntryRaw] -> ShowS)
-> Show TableEntryRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableEntryRaw -> ShowS
showsPrec :: Int -> TableEntryRaw -> ShowS
$cshow :: TableEntryRaw -> String
show :: TableEntryRaw -> String
$cshowList :: [TableEntryRaw] -> ShowS
showList :: [TableEntryRaw] -> ShowS
Show, TableEntryRaw -> TableEntryRaw -> Bool
(TableEntryRaw -> TableEntryRaw -> Bool)
-> (TableEntryRaw -> TableEntryRaw -> Bool) -> Eq TableEntryRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableEntryRaw -> TableEntryRaw -> Bool
== :: TableEntryRaw -> TableEntryRaw -> Bool
$c/= :: TableEntryRaw -> TableEntryRaw -> Bool
/= :: TableEntryRaw -> TableEntryRaw -> Bool
Eq, (forall x. TableEntryRaw -> Rep TableEntryRaw x)
-> (forall x. Rep TableEntryRaw x -> TableEntryRaw)
-> Generic TableEntryRaw
forall x. Rep TableEntryRaw x -> TableEntryRaw
forall x. TableEntryRaw -> Rep TableEntryRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableEntryRaw -> Rep TableEntryRaw x
from :: forall x. TableEntryRaw -> Rep TableEntryRaw x
$cto :: forall x. Rep TableEntryRaw x -> TableEntryRaw
to :: forall x. Rep TableEntryRaw x -> TableEntryRaw
Generic)


instance ToJSON TableEntryRaw
instance FromRow TableEntryRaw


data UniqueConstraint = UniqueConstraint
  { UniqueConstraint -> Maybe Text
name :: Maybe Text
  , UniqueConstraint -> [Text]
columns :: [Text]
  }
  deriving (Int -> UniqueConstraint -> ShowS
[UniqueConstraint] -> ShowS
UniqueConstraint -> String
(Int -> UniqueConstraint -> ShowS)
-> (UniqueConstraint -> String)
-> ([UniqueConstraint] -> ShowS)
-> Show UniqueConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UniqueConstraint -> ShowS
showsPrec :: Int -> UniqueConstraint -> ShowS
$cshow :: UniqueConstraint -> String
show :: UniqueConstraint -> String
$cshowList :: [UniqueConstraint] -> ShowS
showList :: [UniqueConstraint] -> ShowS
Show, UniqueConstraint -> UniqueConstraint -> Bool
(UniqueConstraint -> UniqueConstraint -> Bool)
-> (UniqueConstraint -> UniqueConstraint -> Bool)
-> Eq UniqueConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UniqueConstraint -> UniqueConstraint -> Bool
== :: UniqueConstraint -> UniqueConstraint -> Bool
$c/= :: UniqueConstraint -> UniqueConstraint -> Bool
/= :: UniqueConstraint -> UniqueConstraint -> Bool
Eq, (forall x. UniqueConstraint -> Rep UniqueConstraint x)
-> (forall x. Rep UniqueConstraint x -> UniqueConstraint)
-> Generic UniqueConstraint
forall x. Rep UniqueConstraint x -> UniqueConstraint
forall x. UniqueConstraint -> Rep UniqueConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. UniqueConstraint -> Rep UniqueConstraint x
from :: forall x. UniqueConstraint -> Rep UniqueConstraint x
$cto :: forall x. Rep UniqueConstraint x -> UniqueConstraint
to :: forall x. Rep UniqueConstraint x -> UniqueConstraint
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 (Int -> ReferencesConstraintColumns -> ShowS
[ReferencesConstraintColumns] -> ShowS
ReferencesConstraintColumns -> String
(Int -> ReferencesConstraintColumns -> ShowS)
-> (ReferencesConstraintColumns -> String)
-> ([ReferencesConstraintColumns] -> ShowS)
-> Show ReferencesConstraintColumns
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReferencesConstraintColumns -> ShowS
showsPrec :: Int -> ReferencesConstraintColumns -> ShowS
$cshow :: ReferencesConstraintColumns -> String
show :: ReferencesConstraintColumns -> String
$cshowList :: [ReferencesConstraintColumns] -> ShowS
showList :: [ReferencesConstraintColumns] -> ShowS
Show, ReferencesConstraintColumns -> ReferencesConstraintColumns -> Bool
(ReferencesConstraintColumns
 -> ReferencesConstraintColumns -> Bool)
-> (ReferencesConstraintColumns
    -> ReferencesConstraintColumns -> Bool)
-> Eq ReferencesConstraintColumns
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReferencesConstraintColumns -> ReferencesConstraintColumns -> Bool
== :: ReferencesConstraintColumns -> ReferencesConstraintColumns -> Bool
$c/= :: ReferencesConstraintColumns -> ReferencesConstraintColumns -> Bool
/= :: ReferencesConstraintColumns -> ReferencesConstraintColumns -> Bool
Eq, (forall x.
 ReferencesConstraintColumns -> Rep ReferencesConstraintColumns x)
-> (forall x.
    Rep ReferencesConstraintColumns x -> ReferencesConstraintColumns)
-> Generic ReferencesConstraintColumns
forall x.
Rep ReferencesConstraintColumns x -> ReferencesConstraintColumns
forall x.
ReferencesConstraintColumns -> Rep ReferencesConstraintColumns x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
ReferencesConstraintColumns -> Rep ReferencesConstraintColumns x
from :: forall x.
ReferencesConstraintColumns -> Rep ReferencesConstraintColumns x
$cto :: forall x.
Rep ReferencesConstraintColumns x -> ReferencesConstraintColumns
to :: forall x.
Rep ReferencesConstraintColumns x -> ReferencesConstraintColumns
Generic)


instance ToJSON ReferencesConstraintColumns


data ReferencesConstraint = ReferencesConstraint
  { ReferencesConstraint -> Maybe Text
name :: Maybe Text
  , ReferencesConstraint -> Text
table :: Text
  , ReferencesConstraint -> ReferencesConstraintColumns
columns :: ReferencesConstraintColumns
  }
  deriving (Int -> ReferencesConstraint -> ShowS
[ReferencesConstraint] -> ShowS
ReferencesConstraint -> String
(Int -> ReferencesConstraint -> ShowS)
-> (ReferencesConstraint -> String)
-> ([ReferencesConstraint] -> ShowS)
-> Show ReferencesConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReferencesConstraint -> ShowS
showsPrec :: Int -> ReferencesConstraint -> ShowS
$cshow :: ReferencesConstraint -> String
show :: ReferencesConstraint -> String
$cshowList :: [ReferencesConstraint] -> ShowS
showList :: [ReferencesConstraint] -> ShowS
Show, ReferencesConstraint -> ReferencesConstraint -> Bool
(ReferencesConstraint -> ReferencesConstraint -> Bool)
-> (ReferencesConstraint -> ReferencesConstraint -> Bool)
-> Eq ReferencesConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReferencesConstraint -> ReferencesConstraint -> Bool
== :: ReferencesConstraint -> ReferencesConstraint -> Bool
$c/= :: ReferencesConstraint -> ReferencesConstraint -> Bool
/= :: ReferencesConstraint -> ReferencesConstraint -> Bool
Eq, (forall x. ReferencesConstraint -> Rep ReferencesConstraint x)
-> (forall x. Rep ReferencesConstraint x -> ReferencesConstraint)
-> Generic ReferencesConstraint
forall x. Rep ReferencesConstraint x -> ReferencesConstraint
forall x. ReferencesConstraint -> Rep ReferencesConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ReferencesConstraint -> Rep ReferencesConstraint x
from :: forall x. ReferencesConstraint -> Rep ReferencesConstraint x
$cto :: forall x. Rep ReferencesConstraint x -> ReferencesConstraint
to :: forall x. Rep ReferencesConstraint x -> ReferencesConstraint
Generic)


instance ToJSON ReferencesConstraint


data CheckConstraint = CheckConstraint
  { CheckConstraint -> Maybe Text
name :: Maybe Text
  , CheckConstraint -> Text
predicate :: Text
  , CheckConstraint -> Maybe [Text]
columns :: Maybe [Text]
  }
  deriving (Int -> CheckConstraint -> ShowS
[CheckConstraint] -> ShowS
CheckConstraint -> String
(Int -> CheckConstraint -> ShowS)
-> (CheckConstraint -> String)
-> ([CheckConstraint] -> ShowS)
-> Show CheckConstraint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CheckConstraint -> ShowS
showsPrec :: Int -> CheckConstraint -> ShowS
$cshow :: CheckConstraint -> String
show :: CheckConstraint -> String
$cshowList :: [CheckConstraint] -> ShowS
showList :: [CheckConstraint] -> ShowS
Show, CheckConstraint -> CheckConstraint -> Bool
(CheckConstraint -> CheckConstraint -> Bool)
-> (CheckConstraint -> CheckConstraint -> Bool)
-> Eq CheckConstraint
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CheckConstraint -> CheckConstraint -> Bool
== :: CheckConstraint -> CheckConstraint -> Bool
$c/= :: CheckConstraint -> CheckConstraint -> Bool
/= :: CheckConstraint -> CheckConstraint -> Bool
Eq, (forall x. CheckConstraint -> Rep CheckConstraint x)
-> (forall x. Rep CheckConstraint x -> CheckConstraint)
-> Generic CheckConstraint
forall x. Rep CheckConstraint x -> CheckConstraint
forall x. CheckConstraint -> Rep CheckConstraint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CheckConstraint -> Rep CheckConstraint x
from :: forall x. CheckConstraint -> Rep CheckConstraint x
$cto :: forall x. Rep CheckConstraint x -> CheckConstraint
to :: forall x. Rep CheckConstraint x -> CheckConstraint
Generic)


instance ToJSON CheckConstraint


data TableEntry = TableEntry
  { TableEntry -> Text
name :: Text
  , TableEntry -> Text
tbl_name :: Text
  , TableEntry -> ObjectType
object_type :: ObjectType
  , TableEntry -> Int
rootpage :: Int
  , TableEntry -> Text
sql :: Text
  , TableEntry -> Statement
statement :: Statement
  , TableEntry -> [UniqueConstraint]
uniqueConstraints :: [UniqueConstraint]
  , TableEntry -> [ReferencesConstraint]
referencesConstraints :: [ReferencesConstraint]
  , TableEntry -> [CheckConstraint]
checkConstraints :: [CheckConstraint]
  , TableEntry -> [ColumnEntry]
columns :: [ColumnEntry]
  }
  deriving (Int -> TableEntry -> ShowS
[TableEntry] -> ShowS
TableEntry -> String
(Int -> TableEntry -> ShowS)
-> (TableEntry -> String)
-> ([TableEntry] -> ShowS)
-> Show TableEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TableEntry -> ShowS
showsPrec :: Int -> TableEntry -> ShowS
$cshow :: TableEntry -> String
show :: TableEntry -> String
$cshowList :: [TableEntry] -> ShowS
showList :: [TableEntry] -> ShowS
Show, TableEntry -> TableEntry -> Bool
(TableEntry -> TableEntry -> Bool)
-> (TableEntry -> TableEntry -> Bool) -> Eq TableEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TableEntry -> TableEntry -> Bool
== :: TableEntry -> TableEntry -> Bool
$c/= :: TableEntry -> TableEntry -> Bool
/= :: TableEntry -> TableEntry -> Bool
Eq, (forall x. TableEntry -> Rep TableEntry x)
-> (forall x. Rep TableEntry x -> TableEntry) -> Generic TableEntry
forall x. Rep TableEntry x -> TableEntry
forall x. TableEntry -> Rep TableEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TableEntry -> Rep TableEntry x
from :: forall x. TableEntry -> Rep TableEntry x
$cto :: forall x. Rep TableEntry x -> TableEntry
to :: forall x. Rep TableEntry x -> TableEntry
Generic)


-- | As requested from SQLite
data ColumnEntryRaw = ColumnEntryRaw
  { ColumnEntryRaw -> Int
cid :: Int
  , ColumnEntryRaw -> Text
column_name :: Text
  , ColumnEntryRaw -> Text
datatype :: Text
  , ColumnEntryRaw -> Int
notnull :: Int -- TODO: Should be boolean
  , ColumnEntryRaw -> Maybe Text
dflt_value :: Maybe Text
  , ColumnEntryRaw -> Int
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
    ColumnEntryRaw -> Int
hidden :: Int
  }
  deriving (Int -> ColumnEntryRaw -> ShowS
[ColumnEntryRaw] -> ShowS
ColumnEntryRaw -> String
(Int -> ColumnEntryRaw -> ShowS)
-> (ColumnEntryRaw -> String)
-> ([ColumnEntryRaw] -> ShowS)
-> Show ColumnEntryRaw
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnEntryRaw -> ShowS
showsPrec :: Int -> ColumnEntryRaw -> ShowS
$cshow :: ColumnEntryRaw -> String
show :: ColumnEntryRaw -> String
$cshowList :: [ColumnEntryRaw] -> ShowS
showList :: [ColumnEntryRaw] -> ShowS
Show, ColumnEntryRaw -> ColumnEntryRaw -> Bool
(ColumnEntryRaw -> ColumnEntryRaw -> Bool)
-> (ColumnEntryRaw -> ColumnEntryRaw -> Bool) -> Eq ColumnEntryRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnEntryRaw -> ColumnEntryRaw -> Bool
== :: ColumnEntryRaw -> ColumnEntryRaw -> Bool
$c/= :: ColumnEntryRaw -> ColumnEntryRaw -> Bool
/= :: ColumnEntryRaw -> ColumnEntryRaw -> Bool
Eq, (forall x. ColumnEntryRaw -> Rep ColumnEntryRaw x)
-> (forall x. Rep ColumnEntryRaw x -> ColumnEntryRaw)
-> Generic ColumnEntryRaw
forall x. Rep ColumnEntryRaw x -> ColumnEntryRaw
forall x. ColumnEntryRaw -> Rep ColumnEntryRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnEntryRaw -> Rep ColumnEntryRaw x
from :: forall x. ColumnEntryRaw -> Rep ColumnEntryRaw x
$cto :: forall x. Rep ColumnEntryRaw x -> ColumnEntryRaw
to :: forall x. Rep ColumnEntryRaw x -> ColumnEntryRaw
Generic)


instance FromRow ColumnEntryRaw


data GqlTypeName = GqlTypeName
  { GqlTypeName -> Text
root :: Text
  , GqlTypeName -> Text
full :: Text
  }
  deriving (Int -> GqlTypeName -> ShowS
[GqlTypeName] -> ShowS
GqlTypeName -> String
(Int -> GqlTypeName -> ShowS)
-> (GqlTypeName -> String)
-> ([GqlTypeName] -> ShowS)
-> Show GqlTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GqlTypeName -> ShowS
showsPrec :: Int -> GqlTypeName -> ShowS
$cshow :: GqlTypeName -> String
show :: GqlTypeName -> String
$cshowList :: [GqlTypeName] -> ShowS
showList :: [GqlTypeName] -> ShowS
Show, GqlTypeName -> GqlTypeName -> Bool
(GqlTypeName -> GqlTypeName -> Bool)
-> (GqlTypeName -> GqlTypeName -> Bool) -> Eq GqlTypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GqlTypeName -> GqlTypeName -> Bool
== :: GqlTypeName -> GqlTypeName -> Bool
$c/= :: GqlTypeName -> GqlTypeName -> Bool
/= :: GqlTypeName -> GqlTypeName -> Bool
Eq, (forall x. GqlTypeName -> Rep GqlTypeName x)
-> (forall x. Rep GqlTypeName x -> GqlTypeName)
-> Generic GqlTypeName
forall x. Rep GqlTypeName x -> GqlTypeName
forall x. GqlTypeName -> Rep GqlTypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. GqlTypeName -> Rep GqlTypeName x
from :: forall x. GqlTypeName -> Rep GqlTypeName x
$cto :: forall x. Rep GqlTypeName x -> GqlTypeName
to :: forall x. Rep GqlTypeName x -> GqlTypeName
Generic)


instance ToJSON GqlTypeName


-- | Enhanced with generated information from SQL query "CREATE TABLE"
data ColumnEntry = ColumnEntry
  { ColumnEntry -> Text
column_name :: Text
  , ColumnEntry -> Text
column_name_gql :: Text
  , ColumnEntry -> Text
datatype :: Text
  -- ^ double-X-encoded GQL identifiers
  , ColumnEntry -> Maybe GqlTypeName
datatype_gql :: Maybe GqlTypeName
  , ColumnEntry -> Maybe [Text]
select_options :: Maybe [Text]
  , ColumnEntry -> Bool
notnull :: Bool
  , ColumnEntry -> Bool
isGenerated :: Bool
  , ColumnEntry -> Bool
isUnique :: Bool
  , ColumnEntry -> Bool
isOmittable :: Bool
  -- ^ If column is NON NULL, but will be set automatically
  , ColumnEntry -> Maybe Text
dflt_value :: Maybe Text
  , ColumnEntry -> Bool
primary_key :: Bool
  }
  deriving (Int -> ColumnEntry -> ShowS
[ColumnEntry] -> ShowS
ColumnEntry -> String
(Int -> ColumnEntry -> ShowS)
-> (ColumnEntry -> String)
-> ([ColumnEntry] -> ShowS)
-> Show ColumnEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ColumnEntry -> ShowS
showsPrec :: Int -> ColumnEntry -> ShowS
$cshow :: ColumnEntry -> String
show :: ColumnEntry -> String
$cshowList :: [ColumnEntry] -> ShowS
showList :: [ColumnEntry] -> ShowS
Show, ColumnEntry -> ColumnEntry -> Bool
(ColumnEntry -> ColumnEntry -> Bool)
-> (ColumnEntry -> ColumnEntry -> Bool) -> Eq ColumnEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ColumnEntry -> ColumnEntry -> Bool
== :: ColumnEntry -> ColumnEntry -> Bool
$c/= :: ColumnEntry -> ColumnEntry -> Bool
/= :: ColumnEntry -> ColumnEntry -> Bool
Eq, (forall x. ColumnEntry -> Rep ColumnEntry x)
-> (forall x. Rep ColumnEntry x -> ColumnEntry)
-> Generic ColumnEntry
forall x. Rep ColumnEntry x -> ColumnEntry
forall x. ColumnEntry -> Rep ColumnEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ColumnEntry -> Rep ColumnEntry x
from :: forall x. ColumnEntry -> Rep ColumnEntry x
$cto :: forall x. Rep ColumnEntry x -> ColumnEntry
to :: forall x. Rep ColumnEntry x -> ColumnEntry
Generic)


instance ToJSON ColumnEntry


data ParsedTable = ParsedTable
  { ParsedTable -> [UniqueConstraint]
uniqueConstraints :: [UniqueConstraint]
  , ParsedTable -> [ReferencesConstraint]
referencesConstraints :: [ReferencesConstraint]
  , ParsedTable -> [CheckConstraint]
checkConstraints :: [CheckConstraint]
  , ParsedTable -> Statement
statement :: Statement
  }
  deriving (Int -> ParsedTable -> ShowS
[ParsedTable] -> ShowS
ParsedTable -> String
(Int -> ParsedTable -> ShowS)
-> (ParsedTable -> String)
-> ([ParsedTable] -> ShowS)
-> Show ParsedTable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParsedTable -> ShowS
showsPrec :: Int -> ParsedTable -> ShowS
$cshow :: ParsedTable -> String
show :: ParsedTable -> String
$cshowList :: [ParsedTable] -> ShowS
showList :: [ParsedTable] -> ShowS
Show, ParsedTable -> ParsedTable -> Bool
(ParsedTable -> ParsedTable -> Bool)
-> (ParsedTable -> ParsedTable -> Bool) -> Eq ParsedTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParsedTable -> ParsedTable -> Bool
== :: ParsedTable -> ParsedTable -> Bool
$c/= :: ParsedTable -> ParsedTable -> Bool
/= :: ParsedTable -> ParsedTable -> Bool
Eq, (forall x. ParsedTable -> Rep ParsedTable x)
-> (forall x. Rep ParsedTable x -> ParsedTable)
-> Generic ParsedTable
forall x. Rep ParsedTable x -> ParsedTable
forall x. ParsedTable -> Rep ParsedTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParsedTable -> Rep ParsedTable x
from :: forall x. ParsedTable -> Rep ParsedTable x
$cto :: forall x. Rep ParsedTable x -> ParsedTable
to :: forall x. Rep ParsedTable x -> ParsedTable
Generic)


getTables :: Connection -> IO [TableEntryRaw]
getTables :: Connection -> IO [TableEntryRaw]
getTables Connection
connection = do
  Connection -> Query -> IO [TableEntryRaw]
forall r. FromRow r => Connection -> Query -> IO [r]
query_
    Connection
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 -> IO [Text]
getTableNames Connection
connection = do
  [Only Text]
results :: [SS.Only Text] <-
    Connection -> Query -> IO [Only Text]
forall r. FromRow r => Connection -> Query -> IO [r]
query_
      Connection
connection
      [SS.sql|
        SELECT tbl_name
        FROM sqlite_master
        WHERE type='table' or type='view'
      |]

  [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Only Text -> Text
forall a. Only a -> a
SS.fromOnly (Only Text -> Text) -> [Only Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Only Text]
results)


getColumnNames :: Connection -> Text -> IO [Text]
getColumnNames :: Connection -> Text -> IO [Text]
getColumnNames Connection
connection Text
tableName = do
  [Only Text]
results :: [SS.Only Text] <-
    Connection -> Query -> IO [Only Text]
forall r. FromRow r => Connection -> Query -> IO [r]
query_
      Connection
connection
      (Query -> IO [Only Text]) -> Query -> IO [Only Text]
forall a b. (a -> b) -> a -> b
$ Text -> Query
SS.Query
      (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$ Text
"SELECT name FROM pragma_table_xinfo(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteText Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
  [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Only Text -> Text
forall a. Only a -> a
SS.fromOnly (Only Text -> Text) -> [Only Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Only Text]
results)


-- TODO: investigate whether we ever want to quote the result
nameAsText :: SQL.Name -> Text
nameAsText :: Name -> Text
nameAsText = \case
  SQL.Name Maybe (String, String)
_ String
name -> String -> Text
T.pack String
name


getFirstName :: Maybe [SQL.Name] -> Maybe Text
getFirstName :: Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
namesMb = do
  [Name]
names <- Maybe [Name]
namesMb
  Name
first <- [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [Name]
names
  Text -> Maybe Text
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Text
nameAsText Name
first)


getColumnUniqueConstraint
  :: Text
  -> SQL.ColConstraintDef
  -> Maybe UniqueConstraint
getColumnUniqueConstraint :: Text -> ColConstraintDef -> Maybe UniqueConstraint
getColumnUniqueConstraint Text
col_name = \case
  SQL.ColConstraintDef Maybe [Name]
names ColConstraint
SQL.ColUniqueConstraint ->
    UniqueConstraint -> Maybe UniqueConstraint
forall a. a -> Maybe a
Just (UniqueConstraint -> Maybe UniqueConstraint)
-> UniqueConstraint -> Maybe UniqueConstraint
forall a b. (a -> b) -> a -> b
$
      UniqueConstraint
        { $sel:name:UniqueConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:columns:UniqueConstraint :: [Text]
columns = [Text
col_name]
        }
  -- Primary keys are unique by default, even though they do not have an unique index
  SQL.ColConstraintDef Maybe [Name]
names (SQL.ColPrimaryKeyConstraint Bool
_) ->
    UniqueConstraint -> Maybe UniqueConstraint
forall a. a -> Maybe a
Just (UniqueConstraint -> Maybe UniqueConstraint)
-> UniqueConstraint -> Maybe UniqueConstraint
forall a b. (a -> b) -> a -> b
$
      UniqueConstraint
        { $sel:name:UniqueConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:columns:UniqueConstraint :: [Text]
columns = [Text
col_name]
        }
  ColConstraintDef
_ -> Maybe UniqueConstraint
forall a. Maybe a
Nothing


tableUniqueConstraints :: SQL.TableElement -> [UniqueConstraint]
tableUniqueConstraints :: TableElement -> [UniqueConstraint]
tableUniqueConstraints = \case
  SQL.TableConstraintDef Maybe [Name]
names (SQL.TableUniqueConstraint [Name]
columns) ->
    [ UniqueConstraint
        { $sel:name:UniqueConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:columns:UniqueConstraint :: [Text]
columns = (Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap Name -> Text
nameAsText [Name]
columns
        }
    ]
  -- Primary keys are unique by default, even though they do not have an unique index
  SQL.TableConstraintDef Maybe [Name]
names (SQL.TablePrimaryKeyConstraint [Name]
columns) ->
    [ UniqueConstraint
        { $sel:name:UniqueConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:columns:UniqueConstraint :: [Text]
columns = (Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap Name -> Text
nameAsText [Name]
columns
        }
    ]
  SQL.TableColumnDef (SQL.ColumnDef Name
col_name TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
constraints) ->
    (ColConstraintDef -> Maybe UniqueConstraint)
-> [ColConstraintDef] -> [UniqueConstraint]
forall a b. (a -> Maybe b) -> [a] -> [b]
P.mapMaybe (Text -> ColConstraintDef -> Maybe UniqueConstraint
getColumnUniqueConstraint (Name -> Text
nameAsText Name
col_name)) [ColConstraintDef]
constraints
  TableElement
_ -> []


getColumnCheckConstraint
  :: Text
  -> SQL.ColConstraintDef
  -> Maybe CheckConstraint
getColumnCheckConstraint :: Text -> ColConstraintDef -> Maybe CheckConstraint
getColumnCheckConstraint Text
col_name = \case
  SQL.ColConstraintDef Maybe [Name]
names (SQL.ColCheckConstraint ScalarExpr
expr) ->
    CheckConstraint -> Maybe CheckConstraint
forall a. a -> Maybe a
Just (CheckConstraint -> Maybe CheckConstraint)
-> CheckConstraint -> Maybe CheckConstraint
forall a b. (a -> b) -> a -> b
$
      CheckConstraint
        { $sel:name:CheckConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:columns:CheckConstraint :: Maybe [Text]
columns = [Text] -> Maybe [Text]
forall a. a -> Maybe a
Just [Text
col_name]
        , $sel:predicate:CheckConstraint :: Text
predicate = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Dialect -> ScalarExpr -> String
prettyScalarExpr Dialect
sqlite ScalarExpr
expr
        }
  ColConstraintDef
_ -> Maybe CheckConstraint
forall a. Maybe a
Nothing


tableCheckConstraints :: SQL.TableElement -> [CheckConstraint]
tableCheckConstraints :: TableElement -> [CheckConstraint]
tableCheckConstraints = \case
  SQL.TableConstraintDef Maybe [Name]
names (SQL.TableCheckConstraint ScalarExpr
expr) ->
    [ CheckConstraint
        { $sel:name:CheckConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
        , $sel:predicate:CheckConstraint :: Text
predicate = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Dialect -> ScalarExpr -> String
prettyScalarExpr Dialect
sqlite ScalarExpr
expr
        , -- not sure how to do this properly
          $sel:columns:CheckConstraint :: Maybe [Text]
columns = Maybe [Text]
forall a. Maybe a
Nothing
        }
    ]
  SQL.TableColumnDef (SQL.ColumnDef Name
col_name TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
constraints) ->
    (ColConstraintDef -> Maybe CheckConstraint)
-> [ColConstraintDef] -> [CheckConstraint]
forall a b. (a -> Maybe b) -> [a] -> [b]
P.mapMaybe (Text -> ColConstraintDef -> Maybe CheckConstraint
getColumnCheckConstraint (Name -> Text
nameAsText Name
col_name)) [ColConstraintDef]
constraints
  TableElement
_ -> []


getColumnReferencesConstraint
  :: Text
  -> SQL.ColConstraintDef
  -> P.Either Text (Maybe ReferencesConstraint)
getColumnReferencesConstraint :: Text
-> ColConstraintDef -> Either Text (Maybe ReferencesConstraint)
getColumnReferencesConstraint Text
col_name = \case
  SQL.ColConstraintDef
    Maybe [Name]
names
    (SQL.ColReferencesConstraint [Name]
table_names Maybe Name
foreign_col_name ReferenceMatch
_ ReferentialAction
_ ReferentialAction
_) -> do
      Name
table_name <-
        Text -> Maybe Name -> Either Text Name
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
P.note Text
"Column references constraint has no table name" (Maybe Name -> Either Text Name) -> Maybe Name -> Either Text Name
forall a b. (a -> b) -> a -> b
$
          [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [Name]
table_names

      Maybe ReferencesConstraint
-> Either Text (Maybe ReferencesConstraint)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ReferencesConstraint
 -> Either Text (Maybe ReferencesConstraint))
-> Maybe ReferencesConstraint
-> Either Text (Maybe ReferencesConstraint)
forall a b. (a -> b) -> a -> b
$
        ReferencesConstraint -> Maybe ReferencesConstraint
forall a. a -> Maybe a
Just (ReferencesConstraint -> Maybe ReferencesConstraint)
-> ReferencesConstraint -> Maybe ReferencesConstraint
forall a b. (a -> b) -> a -> b
$
          ReferencesConstraint
            { $sel:name:ReferencesConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
            , $sel:table:ReferencesConstraint :: Text
table = Name -> Text
nameAsText Name
table_name
            , $sel:columns:ReferencesConstraint :: ReferencesConstraintColumns
columns = case Maybe Name
foreign_col_name of
                Just Name
explicit_col_name ->
                  [(Text, Text)] -> ReferencesConstraintColumns
ExplicitColumns [(Text
col_name, Name -> Text
nameAsText Name
explicit_col_name)]
                Maybe Name
Nothing ->
                  Text -> ReferencesConstraintColumns
ImplicitColumns Text
col_name
            }
  ColConstraintDef
_ -> Maybe ReferencesConstraint
-> Either Text (Maybe ReferencesConstraint)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ReferencesConstraint
forall a. Maybe a
Nothing


tableReferencesConstraints
  :: SQL.TableElement
  -> P.Either Text [ReferencesConstraint]
tableReferencesConstraints :: TableElement -> Either Text [ReferencesConstraint]
tableReferencesConstraints = \case
  SQL.TableConstraintDef
    Maybe [Name]
names
    ( SQL.TableReferencesConstraint
        [Name]
self_columns
        [Name]
table_names
        Maybe [Name]
foreign_columns
        ReferenceMatch
_
        ReferentialAction
_
        ReferentialAction
_
      ) -> do
      Name
table_name <-
        Text -> Maybe Name -> Either Text Name
forall e (m :: * -> *) a. MonadError e m => e -> Maybe a -> m a
P.note Text
"Table references constraint has no table name" (Maybe Name -> Either Text Name) -> Maybe Name -> Either Text Name
forall a b. (a -> b) -> a -> b
$
          [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [Name]
table_names

      ReferencesConstraintColumns
columns <- case ([Name]
self_columns, Maybe [Name]
foreign_columns) of
        ([Name
column], Maybe [Name]
Nothing) ->
          ReferencesConstraintColumns
-> Either Text ReferencesConstraintColumns
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReferencesConstraintColumns
 -> Either Text ReferencesConstraintColumns)
-> ReferencesConstraintColumns
-> Either Text ReferencesConstraintColumns
forall a b. (a -> b) -> a -> b
$ Text -> ReferencesConstraintColumns
ImplicitColumns (Name -> Text
nameAsText Name
column)
        ([Name]
_, Maybe [Name]
Nothing) ->
          Text -> Either Text ReferencesConstraintColumns
forall a. Text -> Either Text a
forall e (m :: * -> *) a. MonadError e m => e -> m a
P.throwError
            Text
"References constraints where more than one column is \
            \implicit are not supported"
        ([Name]
columns, Just [Name]
many_foreign_columns) -> do
          Bool -> Either Text () -> Either Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
P.when ([Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Name]
columns Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Name] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
P.length [Name]
many_foreign_columns) (Either Text () -> Either Text ())
-> Either Text () -> Either Text ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> Either Text ()
forall a. Text -> Either Text a
forall e (m :: * -> *) a. MonadError e m => e -> m a
P.throwError
              Text
"Number of columns in references constraint \
              \must be equal"

          ReferencesConstraintColumns
-> Either Text ReferencesConstraintColumns
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ReferencesConstraintColumns
 -> Either Text ReferencesConstraintColumns)
-> ReferencesConstraintColumns
-> Either Text ReferencesConstraintColumns
forall a b. (a -> b) -> a -> b
$
            [(Text, Text)] -> ReferencesConstraintColumns
ExplicitColumns ([(Text, Text)] -> ReferencesConstraintColumns)
-> [(Text, Text)] -> ReferencesConstraintColumns
forall a b. (a -> b) -> a -> b
$
              [Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
P.zip
                ((Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap Name -> Text
nameAsText [Name]
columns)
                ((Name -> Text) -> [Name] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap Name -> Text
nameAsText [Name]
many_foreign_columns)

      [ReferencesConstraint] -> Either Text [ReferencesConstraint]
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        [ ReferencesConstraint
            { $sel:name:ReferencesConstraint :: Maybe Text
name = Maybe [Name] -> Maybe Text
getFirstName Maybe [Name]
names
            , $sel:table:ReferencesConstraint :: Text
table = Name -> Text
nameAsText Name
table_name
            , $sel:columns:ReferencesConstraint :: ReferencesConstraintColumns
columns = ReferencesConstraintColumns
columns
            }
        ]
  SQL.TableColumnDef (SQL.ColumnDef Name
col_name TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
constraints) ->
    -- => [ColumnConstraint]
    [ColConstraintDef]
constraints
      -- => [Either Text (Maybe ColumnConstraint)]
      [ColConstraintDef]
-> (ColConstraintDef -> Either Text (Maybe ReferencesConstraint))
-> [Either Text (Maybe ReferencesConstraint)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text
-> ColConstraintDef -> Either Text (Maybe ReferencesConstraint)
getColumnReferencesConstraint (Name -> Text
nameAsText Name
col_name)
      -- => Either Text [Maybe ColumnConstraint]
      [Either Text (Maybe ReferencesConstraint)]
-> ([Either Text (Maybe ReferencesConstraint)]
    -> Either Text [Maybe ReferencesConstraint])
-> Either Text [Maybe ReferencesConstraint]
forall a b. a -> (a -> b) -> b
& [Either Text (Maybe ReferencesConstraint)]
-> Either Text [Maybe ReferencesConstraint]
forall b. [Either Text b] -> Either Text [b]
collectAllErrorsAsText
      -- => Either Text [ColumnConstraint]
      Either Text [Maybe ReferencesConstraint]
-> ([Maybe ReferencesConstraint] -> [ReferencesConstraint])
-> Either Text [ReferencesConstraint]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Maybe ReferencesConstraint] -> [ReferencesConstraint]
forall a. [Maybe a] -> [a]
P.catMaybes
  TableElement
_ -> [ReferencesConstraint] -> Either Text [ReferencesConstraint]
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


getTableUniqueIndexConstraints :: SS.Connection -> Text -> IO [UniqueConstraint]
getTableUniqueIndexConstraints :: Connection -> Text -> IO [UniqueConstraint]
getTableUniqueIndexConstraints Connection
connection Text
tableName = do
  [[SQLData]]
indices :: [[SQLData]] <-
    IO [[SQLData]]
-> (SomeException -> IO [[SQLData]]) -> IO [[SQLData]]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
      ( Connection -> Query -> [Text] -> IO [[SQLData]]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
SS.query
          Connection
connection
          [SS.sql|
        SELECT sql
        FROM sqlite_master
        WHERE tbl_name = ? AND type = 'index'
      |]
          [Text
tableName]
      )
      (\SomeException
_ -> [[SQLData]] -> IO [[SQLData]]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])

  [[SQLData]]
indices
    [[SQLData]]
-> ([SQLData] -> Maybe UniqueConstraint)
-> [Maybe UniqueConstraint]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      [SQLText Text
sqlTxt]
        -- Get column name from SQL query
        | P.Right (SQL.CreateIndex Bool
True [Name]
indexNames [Name]
_ [Name]
columns) <-
            Text -> Either ParseError Statement
parseSql Text
sqlTxt -> do
            UniqueConstraint -> Maybe UniqueConstraint
forall a. a -> Maybe a
Just (UniqueConstraint -> Maybe UniqueConstraint)
-> UniqueConstraint -> Maybe UniqueConstraint
forall a b. (a -> b) -> a -> b
$
              UniqueConstraint
                { $sel:name:UniqueConstraint :: Maybe Text
name = Name -> Text
nameAsText (Name -> Text) -> Maybe Name -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [Name]
indexNames
                , $sel:columns:UniqueConstraint :: [Text]
columns = Name -> Text
nameAsText (Name -> Text) -> [Name] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
columns
                }
      [SQLData]
_ -> Maybe UniqueConstraint
forall a. Maybe a
Nothing
    [Maybe UniqueConstraint]
-> ([Maybe UniqueConstraint] -> [UniqueConstraint])
-> [UniqueConstraint]
forall a b. a -> (a -> b) -> b
& [Maybe UniqueConstraint] -> [UniqueConstraint]
forall a. [Maybe a] -> [a]
P.catMaybes
    [UniqueConstraint]
-> ([UniqueConstraint] -> IO [UniqueConstraint])
-> IO [UniqueConstraint]
forall a b. a -> (a -> b) -> b
& [UniqueConstraint] -> IO [UniqueConstraint]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


getSqlObjectName :: Statement -> Maybe Text
getSqlObjectName :: Statement -> Maybe Text
getSqlObjectName = \case
  SQL.CreateTable [Name]
names [TableElement]
_ ->
    [Name]
names
      [Name] -> ([Name] -> Maybe Name) -> Maybe Name
forall a b. a -> (a -> b) -> b
& [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head
      Maybe Name -> (Name -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Name -> Text
nameAsText
  SQL.CreateView Bool
_ [Name]
_ Maybe [Name]
names QueryExpr
_ Maybe CheckOption
_ ->
    Maybe [Name]
names
      Maybe [Name] -> ([Name] -> Maybe Name) -> Maybe Name
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Name] -> Maybe Name
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head
        Maybe Name -> (Name -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Name -> Text
nameAsText
  Statement
_ -> Maybe Text
forall a. Maybe a
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 :: Maybe Connection -> Statement -> IO (Either Text ParsedTable)
collectTableConstraints Maybe Connection
connectionMb Statement
statement = do
  [UniqueConstraint]
uniqueIndices <- case (Maybe Connection
connectionMb, Statement -> Maybe Text
getSqlObjectName Statement
statement) of
    (Just Connection
conn, Just Text
name) -> Connection -> Text -> IO [UniqueConstraint]
getTableUniqueIndexConstraints Connection
conn Text
name
    (Maybe Connection, Maybe Text)
_ -> [UniqueConstraint] -> IO [UniqueConstraint]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  case Statement
statement of
    CreateTable [Name]
_ [TableElement]
elements -> do
      let referencesConstraintsEither :: Either Text [ReferencesConstraint]
referencesConstraintsEither =
            -- => [TableElemenet]
            [TableElement]
elements
              -- =>  [Either Text TableElemenet]
              [TableElement]
-> ([TableElement] -> [Either Text [ReferencesConstraint]])
-> [Either Text [ReferencesConstraint]]
forall a b. a -> (a -> b) -> b
& (TableElement -> Either Text [ReferencesConstraint])
-> [TableElement] -> [Either Text [ReferencesConstraint]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap TableElement -> Either Text [ReferencesConstraint]
tableReferencesConstraints
              -- =>  Either Text [[TableElemenet]]
              [Either Text [ReferencesConstraint]]
-> ([Either Text [ReferencesConstraint]]
    -> Either Text [[ReferencesConstraint]])
-> Either Text [[ReferencesConstraint]]
forall a b. a -> (a -> b) -> b
& [Either Text [ReferencesConstraint]]
-> Either Text [[ReferencesConstraint]]
forall b. [Either Text b] -> Either Text [b]
collectAllErrorsAsText
              -- =>  Either Text [TableElemenet]
              Either Text [[ReferencesConstraint]]
-> (Either Text [[ReferencesConstraint]]
    -> Either Text [ReferencesConstraint])
-> Either Text [ReferencesConstraint]
forall a b. a -> (a -> b) -> b
& ([[ReferencesConstraint]] -> [ReferencesConstraint])
-> Either Text [[ReferencesConstraint]]
-> Either Text [ReferencesConstraint]
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap [[ReferencesConstraint]] -> [ReferencesConstraint]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
P.join

      Either Text [ReferencesConstraint]
-> ([ReferencesConstraint] -> IO ParsedTable)
-> IO (Either Text ParsedTable)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for Either Text [ReferencesConstraint]
referencesConstraintsEither (([ReferencesConstraint] -> IO ParsedTable)
 -> IO (Either Text ParsedTable))
-> ([ReferencesConstraint] -> IO ParsedTable)
-> IO (Either Text ParsedTable)
forall a b. (a -> b) -> a -> b
$ \[ReferencesConstraint]
referencesConstraints -> do
        ParsedTable -> IO ParsedTable
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParsedTable -> IO ParsedTable) -> ParsedTable -> IO ParsedTable
forall a b. (a -> b) -> a -> b
$
          ParsedTable
            { $sel:uniqueConstraints:ParsedTable :: [UniqueConstraint]
uniqueConstraints =
                [UniqueConstraint]
uniqueIndices
                  [UniqueConstraint] -> [UniqueConstraint] -> [UniqueConstraint]
forall a. Semigroup a => a -> a -> a
<> ([TableElement]
elements [TableElement]
-> (TableElement -> [UniqueConstraint]) -> [UniqueConstraint]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TableElement -> [UniqueConstraint]
tableUniqueConstraints)
            , $sel:referencesConstraints:ParsedTable :: [ReferencesConstraint]
referencesConstraints = [ReferencesConstraint]
referencesConstraints
            , $sel:checkConstraints:ParsedTable :: [CheckConstraint]
checkConstraints = [TableElement]
elements [TableElement]
-> (TableElement -> [CheckConstraint]) -> [CheckConstraint]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TableElement -> [CheckConstraint]
tableCheckConstraints
            , $sel:statement:ParsedTable :: Statement
statement = Statement
statement
            }
    Statement
_ ->
      Either Text ParsedTable -> IO (Either Text ParsedTable)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ParsedTable -> IO (Either Text ParsedTable))
-> Either Text ParsedTable -> IO (Either Text ParsedTable)
forall a b. (a -> b) -> a -> b
$
        ParsedTable -> Either Text ParsedTable
forall a b. b -> Either a b
P.Right (ParsedTable -> Either Text ParsedTable)
-> ParsedTable -> Either Text ParsedTable
forall a b. (a -> b) -> a -> b
$
          ParsedTable
            { $sel:uniqueConstraints:ParsedTable :: [UniqueConstraint]
uniqueConstraints = [UniqueConstraint]
uniqueIndices
            , $sel:referencesConstraints:ParsedTable :: [ReferencesConstraint]
referencesConstraints = []
            , $sel:checkConstraints:ParsedTable :: [CheckConstraint]
checkConstraints = []
            , $sel:statement:ParsedTable :: Statement
statement = Statement
statement
            }


enrichTableEntry
  :: SS.Connection
  -> TableEntryRaw
  -> IO (P.Either Text TableEntry)
enrichTableEntry :: Connection -> TableEntryRaw -> IO (Either Text TableEntry)
enrichTableEntry Connection
connection tableEntry :: TableEntryRaw
tableEntry@(TableEntryRaw{Int
Text
ObjectType
$sel:name:TableEntryRaw :: TableEntryRaw -> Text
$sel:tbl_name:TableEntryRaw :: TableEntryRaw -> Text
$sel:object_type:TableEntryRaw :: TableEntryRaw -> ObjectType
$sel:rootpage:TableEntryRaw :: TableEntryRaw -> Int
$sel:sql:TableEntryRaw :: TableEntryRaw -> Text
name :: Text
tbl_name :: Text
object_type :: ObjectType
rootpage :: Int
sql :: Text
..}) =
  case Text -> Either ParseError Statement
parseSql TableEntryRaw
tableEntry.sql of
    P.Left ParseError
err -> Either Text TableEntry -> IO (Either Text TableEntry)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text TableEntry -> IO (Either Text TableEntry))
-> Either Text TableEntry -> IO (Either Text TableEntry)
forall a b. (a -> b) -> a -> b
$ Text -> Either Text TableEntry
forall a b. a -> Either a b
P.Left (ParseError -> Text
forall a b. (Show a, StringConv String b) => a -> b
show ParseError
err)
    P.Right Statement
sqlStatement ->
      Maybe Connection -> Statement -> IO (Either Text ParsedTable)
collectTableConstraints (Connection -> Maybe Connection
forall a. a -> Maybe a
Just Connection
connection) Statement
sqlStatement
        IO (Either Text ParsedTable)
-> (Either Text ParsedTable -> Either Text TableEntry)
-> IO (Either Text TableEntry)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ParsedTable -> TableEntry)
-> Either Text ParsedTable -> Either Text TableEntry
forall a b. (a -> b) -> Either Text a -> Either Text b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
P.fmap
          ( \(ParsedTable{[CheckConstraint]
[ReferencesConstraint]
[UniqueConstraint]
Statement
$sel:uniqueConstraints:ParsedTable :: ParsedTable -> [UniqueConstraint]
$sel:referencesConstraints:ParsedTable :: ParsedTable -> [ReferencesConstraint]
$sel:checkConstraints:ParsedTable :: ParsedTable -> [CheckConstraint]
$sel:statement:ParsedTable :: ParsedTable -> Statement
uniqueConstraints :: [UniqueConstraint]
referencesConstraints :: [ReferencesConstraint]
checkConstraints :: [CheckConstraint]
statement :: Statement
..}) ->
              TableEntry{$sel:columns:TableEntry :: [ColumnEntry]
columns = [], Int
[CheckConstraint]
[ReferencesConstraint]
[UniqueConstraint]
Text
Statement
ObjectType
$sel:name:TableEntry :: Text
$sel:tbl_name:TableEntry :: Text
$sel:object_type:TableEntry :: ObjectType
$sel:rootpage:TableEntry :: Int
$sel:sql:TableEntry :: Text
$sel:statement:TableEntry :: Statement
$sel:uniqueConstraints:TableEntry :: [UniqueConstraint]
$sel:referencesConstraints:TableEntry :: [ReferencesConstraint]
$sel:checkConstraints:TableEntry :: [CheckConstraint]
name :: Text
tbl_name :: Text
object_type :: ObjectType
rootpage :: Int
sql :: Text
uniqueConstraints :: [UniqueConstraint]
referencesConstraints :: [ReferencesConstraint]
checkConstraints :: [CheckConstraint]
statement :: Statement
..}
          )


getEnrichedTables :: Connection -> IO (P.Either Text [TableEntry])
getEnrichedTables :: Connection -> IO (Either Text [TableEntry])
getEnrichedTables Connection
connection = do
  [TableEntryRaw]
tables <- Connection -> IO [TableEntryRaw]
getTables Connection
connection
  [Either Text TableEntry]
enriched <- [TableEntryRaw]
-> (TableEntryRaw -> IO (Either Text TableEntry))
-> IO [Either Text TableEntry]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for [TableEntryRaw]
tables ((TableEntryRaw -> IO (Either Text TableEntry))
 -> IO [Either Text TableEntry])
-> (TableEntryRaw -> IO (Either Text TableEntry))
-> IO [Either Text TableEntry]
forall a b. (a -> b) -> a -> b
$ \TableEntryRaw
table -> do
    Either Text TableEntry
enrichedEither <- Connection -> TableEntryRaw -> IO (Either Text TableEntry)
enrichTableEntry Connection
connection TableEntryRaw
table
    Either Text TableEntry
-> (TableEntry -> IO TableEntry) -> IO (Either Text TableEntry)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
P.for Either Text TableEntry
enrichedEither ((TableEntry -> IO TableEntry) -> IO (Either Text TableEntry))
-> (TableEntry -> IO TableEntry) -> IO (Either Text TableEntry)
forall a b. (a -> b) -> a -> b
$ \enriched :: TableEntry
enriched@TableEntry{Int
[ColumnEntry]
[CheckConstraint]
[ReferencesConstraint]
[UniqueConstraint]
Text
Statement
ObjectType
$sel:name:TableEntry :: TableEntry -> Text
$sel:tbl_name:TableEntry :: TableEntry -> Text
$sel:object_type:TableEntry :: TableEntry -> ObjectType
$sel:rootpage:TableEntry :: TableEntry -> Int
$sel:sql:TableEntry :: TableEntry -> Text
$sel:statement:TableEntry :: TableEntry -> Statement
$sel:uniqueConstraints:TableEntry :: TableEntry -> [UniqueConstraint]
$sel:referencesConstraints:TableEntry :: TableEntry -> [ReferencesConstraint]
$sel:checkConstraints:TableEntry :: TableEntry -> [CheckConstraint]
$sel:columns:TableEntry :: TableEntry -> [ColumnEntry]
name :: Text
tbl_name :: Text
object_type :: ObjectType
rootpage :: Int
sql :: Text
statement :: Statement
uniqueConstraints :: [UniqueConstraint]
referencesConstraints :: [ReferencesConstraint]
checkConstraints :: [CheckConstraint]
columns :: [ColumnEntry]
..} -> do
      [ColumnEntry]
tableColumns <-
        Connection -> TableEntry -> IO [ColumnEntry]
getColumnsFromParsedTableEntry
          Connection
connection
          TableEntry
enriched
      TableEntry -> IO TableEntry
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TableEntry -> IO TableEntry) -> TableEntry -> IO TableEntry
forall a b. (a -> b) -> a -> b
$
        TableEntry
          { $sel:columns:TableEntry :: [ColumnEntry]
columns = [ColumnEntry]
tableColumns
          , Int
[CheckConstraint]
[ReferencesConstraint]
[UniqueConstraint]
Text
Statement
ObjectType
$sel:name:TableEntry :: Text
$sel:tbl_name:TableEntry :: Text
$sel:object_type:TableEntry :: ObjectType
$sel:rootpage:TableEntry :: Int
$sel:sql:TableEntry :: Text
$sel:statement:TableEntry :: Statement
$sel:uniqueConstraints:TableEntry :: [UniqueConstraint]
$sel:referencesConstraints:TableEntry :: [ReferencesConstraint]
$sel:checkConstraints:TableEntry :: [CheckConstraint]
name :: Text
tbl_name :: Text
object_type :: ObjectType
rootpage :: Int
sql :: Text
statement :: Statement
uniqueConstraints :: [UniqueConstraint]
referencesConstraints :: [ReferencesConstraint]
checkConstraints :: [CheckConstraint]
..
          }
  Either Text [TableEntry] -> IO (Either Text [TableEntry])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [TableEntry] -> IO (Either Text [TableEntry]))
-> Either Text [TableEntry] -> IO (Either Text [TableEntry])
forall a b. (a -> b) -> a -> b
$ [Either Text TableEntry] -> Either Text [TableEntry]
forall b. [Either Text b] -> Either Text [b]
collectAllErrorsAsText [Either Text TableEntry]
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.
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
-}
resolveReferencesConstraint :: [TableEntry] -> Text -> Maybe Text
resolveReferencesConstraint :: [TableEntry] -> Text -> Maybe Text
resolveReferencesConstraint [TableEntry]
tables Text
referencedTable =
  -- => [(TableEntry, [ColumnEntry])]
  [TableEntry]
tables
    -- => Maybe (TableEntry, [ColumnEntry])
    [TableEntry]
-> ([TableEntry] -> Maybe TableEntry) -> Maybe TableEntry
forall a b. a -> (a -> b) -> b
& (TableEntry -> Bool) -> [TableEntry] -> Maybe TableEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
P.find (\TableEntry
table -> TableEntry
table.tbl_name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
referencedTable)
    -- => Maybe [ColumnEntry]
    Maybe TableEntry
-> (TableEntry -> [ColumnEntry]) -> Maybe [ColumnEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (\TableEntry
table -> TableEntry
table.columns)
    -- => Maybe ColumnEntry
    Maybe [ColumnEntry]
-> ([ColumnEntry] -> Maybe ColumnEntry) -> Maybe ColumnEntry
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ColumnEntry -> Bool) -> [ColumnEntry] -> Maybe ColumnEntry
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
P.find (\ColumnEntry
column -> ColumnEntry
column.primary_key)
      -- => Maybe Text
      Maybe ColumnEntry -> (ColumnEntry -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (.column_name)


--  See the docs for `resolveReferencesConstraint` for details
resolveReferencesConstraintColumns
  :: [TableEntry]
  -> ReferencesConstraint
  -> Maybe [(Text, Text)]
resolveReferencesConstraintColumns :: [TableEntry] -> ReferencesConstraint -> Maybe [(Text, Text)]
resolveReferencesConstraintColumns [TableEntry]
allEntries ReferencesConstraint
constraint =
  case ReferencesConstraint
constraint.columns of
    ExplicitColumns [(Text, Text)]
explicit -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text, Text)]
explicit
    ImplicitColumns Text
from ->
      case [TableEntry] -> Text -> Maybe Text
resolveReferencesConstraint [TableEntry]
allEntries ReferencesConstraint
constraint.table of
        Just Text
to -> [(Text, Text)] -> Maybe [(Text, Text)]
forall a. a -> Maybe a
Just [(Text
from, Text
to)]
        Maybe Text
Nothing -> Maybe [(Text, Text)]
forall a. Maybe a
Nothing


-- | Returns a set of warnings related to a given table.
lintTable :: [TableEntry] -> ParsedTable -> [Text]
lintTable :: [TableEntry] -> ParsedTable -> [Text]
lintTable [TableEntry]
allEntries ParsedTable
parsed =
  let
    rowidReferenceWarnings :: [Text]
rowidReferenceWarnings =
      ParsedTable
parsed.referencesConstraints
        [ReferencesConstraint]
-> ([ReferencesConstraint] -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& (ReferencesConstraint -> Maybe Text)
-> [ReferencesConstraint] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
P.mapMaybe
          ( \ReferencesConstraint
constraint ->
              [TableEntry] -> ReferencesConstraint -> Maybe [(Text, Text)]
resolveReferencesConstraintColumns [TableEntry]
allEntries ReferencesConstraint
constraint
                Maybe [(Text, Text)]
-> (Maybe [(Text, Text)] -> [(Text, Text)]) -> [(Text, Text)]
forall a b. a -> (a -> b) -> b
& [(Text, Text)] -> Maybe [(Text, Text)] -> [(Text, Text)]
forall a. a -> Maybe a -> a
P.fromMaybe []
                [(Text, Text)]
-> ([(Text, Text)] -> Maybe (Text, Text)) -> Maybe (Text, Text)
forall a b. a -> (a -> b) -> b
& ((Text, Text) -> Bool) -> [(Text, Text)] -> Maybe (Text, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
P.find (\(Text
_, Text
to) -> Text
to Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"rowid")
                Maybe (Text, Text) -> ((Text, Text) -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                  (Text
from, Text
_to) ->
                    Text
"Column "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteText Text
from
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" references the rowid column of table "
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteText ReferencesConstraint
constraint.table
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".\n"
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"This is not supported by SQLite:\n"
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"https://www.sqlite.org/foreignkeys.html"
          )
  in
    [Text]
rowidReferenceWarnings


{-| 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)
-}
lintTableCreationCode :: Maybe SS.Connection -> Statement -> IO [Text]
lintTableCreationCode :: Maybe Connection -> Statement -> IO [Text]
lintTableCreationCode Maybe Connection
connectionMb Statement
statement = do
  Either Text ParsedTable
constraintsEither <- Maybe Connection -> Statement -> IO (Either Text ParsedTable)
collectTableConstraints Maybe Connection
connectionMb Statement
statement
  Either Text [TableEntry]
allEntriesEither <- case Maybe Connection
connectionMb of
    Just Connection
connection -> Connection -> IO (Either Text [TableEntry])
getEnrichedTables Connection
connection
    Maybe Connection
Nothing -> Either Text [TableEntry] -> IO (Either Text [TableEntry])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text [TableEntry] -> IO (Either Text [TableEntry]))
-> Either Text [TableEntry] -> IO (Either Text [TableEntry])
forall a b. (a -> b) -> a -> b
$ [TableEntry] -> Either Text [TableEntry]
forall a b. b -> Either a b
Right []
  [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ case (Either Text ParsedTable
constraintsEither, Either Text [TableEntry]
allEntriesEither) of
    (Right ParsedTable
_, Left Text
err) -> [Text
err]
    (Left Text
err, Right [TableEntry]
_) -> [Text
err]
    (Left Text
errL, Left Text
errR) -> [Text
errL, Text
errR]
    (Right ParsedTable
parsed, Right [TableEntry]
allEntries) ->
      [TableEntry] -> ParsedTable -> [Text]
lintTable [TableEntry]
allEntries ParsedTable
parsed


getRowidColumnName :: [Text] -> Text
getRowidColumnName :: [Text] -> Text
getRowidColumnName [Text]
colNames
  | Text
"rowid" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
colNames = Text
"rowid"
  | Text
"_rowid_" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
colNames = Text
"_rowid_"
  | Text
"oid" Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
colNames = Text
"oid"
  | Bool
otherwise = Text
"rowid" -- TODO: Return error to user


columnDefName :: ColumnDef -> Text
columnDefName :: ColumnDef -> Text
columnDefName (ColumnDef Name
name TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
_) = Name -> Text
nameAsText Name
name


-- Computes whether a column is NOT NULL
columnIsNonNull :: SQL.ColumnDef -> Bool
columnIsNonNull :: ColumnDef -> Bool
columnIsNonNull (ColumnDef Name
_ TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
constraints) =
  let isNotNullConstraint :: ColConstraintDef -> Bool
isNotNullConstraint = \case
        ColConstraintDef Maybe [Name]
_ ColConstraint
ColNotNullConstraint -> Bool
True
        ColConstraintDef
_ -> Bool
False
  in  (ColConstraintDef -> Bool) -> [ColConstraintDef] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any ColConstraintDef -> Bool
isNotNullConstraint [ColConstraintDef]
constraints


-- For a single column, returns selectable values
-- E.g. ("color", (SelectOptions ["red", "green", "blue"]))
columnSelectOptions :: SQL.ColumnDef -> Maybe SelectOptions
columnSelectOptions :: ColumnDef -> Maybe SelectOptions
columnSelectOptions (ColumnDef Name
_ TypeName
_ Maybe DefaultClause
_ [ColConstraintDef]
colConstraints) =
  let
    getSelectOptions
      :: ColConstraintDef
      -> Maybe SelectOptions
    getSelectOptions :: ColConstraintDef -> Maybe SelectOptions
getSelectOptions = \case
      ColConstraintDef
        Maybe [Name]
_
        (ColCheckConstraint (In Bool
_ ScalarExpr
_ (InList [ScalarExpr]
options))) ->
          let
            textOnlyOptions :: [Text]
textOnlyOptions =
              [ScalarExpr]
options
                [ScalarExpr] -> (ScalarExpr -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
                  StringLit String
_ String
_ String
value ->
                    String -> Text
T.pack String
value
                  NumLit String
value ->
                    String -> Text
T.pack String
value
                  ScalarExpr
_ -> Text
"UNSUPPORTED"
          in
            SelectOptions -> Maybe SelectOptions
forall a. a -> Maybe a
Just ([Text] -> SelectOptions
SelectOptions [Text]
textOnlyOptions)
      ColConstraintDef
_ -> Maybe SelectOptions
forall a. Maybe a
Nothing
  in
    [ColConstraintDef]
colConstraints
      [ColConstraintDef]
-> ([ColConstraintDef] -> [SelectOptions]) -> [SelectOptions]
forall a b. a -> (a -> b) -> b
& (ColConstraintDef -> Maybe SelectOptions)
-> [ColConstraintDef] -> [SelectOptions]
forall a b. (a -> Maybe b) -> [a] -> [b]
P.mapMaybe ColConstraintDef -> Maybe SelectOptions
getSelectOptions
      [SelectOptions]
-> ([SelectOptions] -> Maybe SelectOptions) -> Maybe SelectOptions
forall a b. a -> (a -> b) -> b
& [SelectOptions] -> Maybe SelectOptions
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head


getColumnsFromParsedTableEntry
  :: Connection
  -> TableEntry
  -> IO [ColumnEntry]
getColumnsFromParsedTableEntry :: Connection -> TableEntry -> IO [ColumnEntry]
getColumnsFromParsedTableEntry Connection
connection TableEntry
tableEntry = do
  [[SQLData]]
keyColumns :: [[SQLData]] <-
    Connection -> Query -> IO [[SQLData]]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
connection (Query -> IO [[SQLData]]) -> Query -> IO [[SQLData]]
forall a b. (a -> b) -> a -> b
$
      Text -> Query
SS.Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
        Text
"SELECT * FROM pragma_index_info("
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteText TableEntry
tableEntry.tbl_name
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

  -- TODO: Catch only SQL specific exceptions
  [ColumnEntryRaw]
colEntriesRaw :: [ColumnEntryRaw] <-
    IO [ColumnEntryRaw]
-> (SomeException -> IO [ColumnEntryRaw]) -> IO [ColumnEntryRaw]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
      ( Connection -> Query -> IO [ColumnEntryRaw]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
connection (Query -> IO [ColumnEntryRaw]) -> Query -> IO [ColumnEntryRaw]
forall a b. (a -> b) -> a -> b
$
          Text -> Query
SS.Query (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$
            Text
"SELECT * FROM pragma_table_xinfo("
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
quoteText TableEntry
tableEntry.tbl_name
              Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
      )
      ( \SomeException
exception -> do
          Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
P.putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Text
forall a b. (Show a, StringConv String b) => a -> b
show SomeException
exception
          [ColumnEntryRaw] -> IO [ColumnEntryRaw]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      )

  let
    tableElementsMb :: Maybe [TableElement]
tableElementsMb = case TableEntry
tableEntry.statement of
      SQL.CreateTable [Name]
_ [TableElement]
tableElements ->
        [TableElement] -> Maybe [TableElement]
forall a. a -> Maybe a
Just [TableElement]
tableElements
      Statement
_ -> Maybe [TableElement]
forall a. Maybe a
Nothing

    columnDefs :: [ColumnDef]
columnDefs = case Maybe [TableElement]
tableElementsMb of
      Just [TableElement]
tableElements ->
        [TableElement]
tableElements
          [TableElement]
-> (TableElement -> Maybe ColumnDef) -> [Maybe ColumnDef]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            TableColumnDef ColumnDef
columnDef -> ColumnDef -> Maybe ColumnDef
forall a. a -> Maybe a
Just ColumnDef
columnDef
            TableElement
_ -> Maybe ColumnDef
forall a. Maybe a
Nothing
          [Maybe ColumnDef]
-> ([Maybe ColumnDef] -> [ColumnDef]) -> [ColumnDef]
forall a b. a -> (a -> b) -> b
& [Maybe ColumnDef] -> [ColumnDef]
forall a. [Maybe a] -> [a]
P.catMaybes
      Maybe [TableElement]
Nothing -> []

    -- As described here: https://www.sqlite.org/withoutrowid.html (Point 5)
    hasRowId :: Bool
    hasRowId :: Bool
hasRowId = [[SQLData]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
P.null [[SQLData]]
keyColumns

    colNames :: [Text]
    colNames :: [Text]
colNames = [ColumnEntryRaw]
colEntriesRaw [ColumnEntryRaw] -> (ColumnEntryRaw -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ColumnEntryRaw
c -> ColumnEntryRaw
c.column_name

    rowIdColName :: Text
    rowIdColName :: Text
rowIdColName = [Text] -> Text
getRowidColumnName [Text]
colNames

    rowIdColumnEntry :: ColumnEntry
    rowIdColumnEntry :: ColumnEntry
rowIdColumnEntry =
      ColumnEntry
        { $sel:column_name:ColumnEntry :: Text
column_name = Text
rowIdColName
        , $sel:column_name_gql:ColumnEntry :: Text
column_name_gql = Text
rowIdColName
        , $sel:datatype:ColumnEntry :: Text
datatype = Text
"INTEGER"
        , $sel:datatype_gql:ColumnEntry :: Maybe GqlTypeName
datatype_gql = GqlTypeName -> Maybe GqlTypeName
forall a. a -> Maybe a
Just (GqlTypeName -> Maybe GqlTypeName)
-> GqlTypeName -> Maybe GqlTypeName
forall a b. (a -> b) -> a -> b
$ Text -> GqlTypeName
stringToGqlTypeName Text
"Int"
        , $sel:select_options:ColumnEntry :: Maybe [Text]
select_options = Maybe [Text]
forall a. Maybe a
P.Nothing
        , $sel:notnull:ColumnEntry :: Bool
notnull = Bool
True
        , $sel:isUnique:ColumnEntry :: Bool
isUnique = Bool
True
        , $sel:isOmittable:ColumnEntry :: Bool
isOmittable = Bool
True
        , $sel:isGenerated:ColumnEntry :: Bool
isGenerated = Bool
False
        , $sel:dflt_value:ColumnEntry :: Maybe Text
dflt_value = Maybe Text
forall a. Maybe a
P.Nothing
        , $sel:primary_key:ColumnEntry :: Bool
primary_key = Bool
True
        }

  let
    entries :: [ColumnEntry]
entries =
      [ColumnEntryRaw]
colEntriesRaw [ColumnEntryRaw]
-> (ColumnEntryRaw -> ColumnEntry) -> [ColumnEntry]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ColumnEntryRaw{Int
Maybe Text
Text
$sel:cid:ColumnEntryRaw :: ColumnEntryRaw -> Int
$sel:column_name:ColumnEntryRaw :: ColumnEntryRaw -> Text
$sel:datatype:ColumnEntryRaw :: ColumnEntryRaw -> Text
$sel:notnull:ColumnEntryRaw :: ColumnEntryRaw -> Int
$sel:dflt_value:ColumnEntryRaw :: ColumnEntryRaw -> Maybe Text
$sel:primary_key:ColumnEntryRaw :: ColumnEntryRaw -> Int
$sel:hidden:ColumnEntryRaw :: ColumnEntryRaw -> Int
cid :: Int
column_name :: Text
datatype :: Text
notnull :: Int
dflt_value :: Maybe Text
primary_key :: Int
hidden :: Int
..}) -> do
        let
          columnDefMb :: Maybe ColumnDef
columnDefMb = (ColumnDef -> Bool) -> [ColumnDef] -> Maybe ColumnDef
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
P.find (\ColumnDef
d -> ColumnDef -> Text
columnDefName ColumnDef
d Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
column_name) [ColumnDef]
columnDefs
          selectOpts :: Maybe SelectOptions
selectOpts = Maybe ColumnDef
columnDefMb Maybe ColumnDef
-> (ColumnDef -> Maybe SelectOptions) -> Maybe SelectOptions
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ColumnDef -> Maybe SelectOptions
columnSelectOptions

        ColumnEntry
          { $sel:column_name_gql:ColumnEntry :: Text
column_name_gql = Text -> Text
doubleXEncodeGql Text
column_name
          , $sel:datatype_gql:ColumnEntry :: Maybe GqlTypeName
datatype_gql =
              Text -> Maybe Text -> Maybe GqlTypeName
sqlTypeNameToGQLTypeName
                Text
datatype
                ( Text -> SelectOptions -> Text
forall a b. a -> b -> a
P.const
                    (TableEntry
tableEntry.tbl_name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
column_name)
                    (SelectOptions -> Text) -> Maybe SelectOptions -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SelectOptions
selectOpts
                )
          , $sel:select_options:ColumnEntry :: Maybe [Text]
select_options = Maybe SelectOptions
selectOpts Maybe SelectOptions -> (SelectOptions -> [Text]) -> Maybe [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> SelectOptions -> [Text]
unSelectOptions
          , $sel:isUnique:ColumnEntry :: Bool
isUnique =
              (UniqueConstraint -> Bool) -> [UniqueConstraint] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.any
                (\UniqueConstraint
constraint -> Text
column_name Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` UniqueConstraint
constraint.columns)
                TableEntry
tableEntry.uniqueConstraints
          , $sel:primary_key:ColumnEntry :: Bool
primary_key = Int
primary_key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
          , $sel:isOmittable:ColumnEntry :: Bool
isOmittable =
              (Int
primary_key Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isPrefixOf Text
"int" (Text -> Text
T.toLower Text
datatype))
                Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
P.isJust Maybe Text
dflt_value
          , $sel:notnull:ColumnEntry :: Bool
notnull =
              Int
notnull Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| case Maybe ColumnDef
columnDefMb of
                Just ColumnDef
columnDef -> ColumnDef -> Bool
columnIsNonNull ColumnDef
columnDef
                Maybe ColumnDef
Nothing -> Bool
False
          , -- See the comment on the `hidden` property of
            -- the `ColumnEntryRaw` type for an explanation.
            $sel:isGenerated:ColumnEntry :: Bool
isGenerated = Int
hidden Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| Int
hidden Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
          , Maybe Text
Text
$sel:column_name:ColumnEntry :: Text
$sel:datatype:ColumnEntry :: Text
$sel:dflt_value:ColumnEntry :: Maybe Text
column_name :: Text
datatype :: Text
dflt_value :: Maybe Text
..
          }
    -- Views don't have a rowid column
    -- (https://stackoverflow.com/q/38519169)
    rowidColumns :: [ColumnEntry]
rowidColumns =
      if Bool
hasRowId Bool -> Bool -> Bool
&& TableEntry
tableEntry.object_type ObjectType -> ObjectType -> Bool
forall a. Eq a => a -> a -> Bool
/= ObjectType
View
        then [ColumnEntry
rowIdColumnEntry]
        else []

  [ColumnEntry] -> IO [ColumnEntry]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ColumnEntry] -> IO [ColumnEntry])
-> [ColumnEntry] -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ [ColumnEntry]
rowidColumns [ColumnEntry] -> [ColumnEntry] -> [ColumnEntry]
forall a. Semigroup a => a -> a -> a
<> [ColumnEntry]
entries


getColumns :: Text -> Connection -> Text -> IO [ColumnEntry]
getColumns :: Text -> Connection -> Text -> IO [ColumnEntry]
getColumns Text
dbId Connection
connection Text
tableName =
  let
    columns :: IO [ColumnEntry]
columns = do
      [TableEntryRaw]
tables :: [TableEntryRaw] <-
        Connection -> Query -> [Text] -> IO [TableEntryRaw]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
SS.query
          Connection
connection
          [SS.sql|
            SELECT name, tbl_name, type, rootpage, sql
            FROM sqlite_master
            WHERE name == ?
          |]
          [Text
tableName]

      TableEntryRaw
table <- case [TableEntryRaw] -> Maybe TableEntryRaw
forall (f :: * -> *) a. Foldable f => f a -> Maybe a
P.head [TableEntryRaw]
tables of
        Just TableEntryRaw
table -> TableEntryRaw -> IO TableEntryRaw
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableEntryRaw
table
        Maybe TableEntryRaw
Nothing ->
          String -> IO TableEntryRaw
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO TableEntryRaw) -> String -> IO TableEntryRaw
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
              [ String
"Could not find table info for table "
              , Text -> String
T.unpack Text
tableName
              , String
" of db "
              , Text -> String
T.unpack Text
dbId
              ]

      Either Text TableEntry
enrichmentResultEither <- Connection -> TableEntryRaw -> IO (Either Text TableEntry)
enrichTableEntry Connection
connection TableEntryRaw
table
      TableEntry
enrichingResult <- case Either Text TableEntry
enrichmentResultEither of
        Right TableEntry
result -> TableEntry -> IO TableEntry
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TableEntry
result
        Left Text
err ->
          String -> IO TableEntry
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO TableEntry) -> String -> IO TableEntry
forall a b. (a -> b) -> a -> b
$
            [String] -> String
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
P.fold
              [ String
"An error occurred while parsing table "
              , Text -> String
T.unpack Text
tableName
              , String
" of db "
              , Text -> String
T.unpack Text
dbId
              , String
": "
              , Text -> String
T.unpack Text
err
              ]
      Connection -> TableEntry -> IO [ColumnEntry]
getColumnsFromParsedTableEntry Connection
connection TableEntry
enrichingResult
  in
    IO [ColumnEntry]
-> (SomeException -> IO [ColumnEntry]) -> IO [ColumnEntry]
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> (SomeException -> m a) -> m a
catchAll
      IO [ColumnEntry]
columns
      ((SomeException -> IO [ColumnEntry]) -> IO [ColumnEntry])
-> (SomeException -> IO [ColumnEntry]) -> IO [ColumnEntry]
forall a b. (a -> b) -> a -> b
$ \SomeException
err -> do
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
P.putErrText (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ SomeException -> Text
forall a b. (Show a, StringConv String b) => a -> b
P.show SomeException
err
        [ColumnEntry] -> IO [ColumnEntry]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []


newtype SelectOptions = SelectOptions {SelectOptions -> [Text]
unSelectOptions :: [Text]}
  deriving (Int -> SelectOptions -> ShowS
[SelectOptions] -> ShowS
SelectOptions -> String
(Int -> SelectOptions -> ShowS)
-> (SelectOptions -> String)
-> ([SelectOptions] -> ShowS)
-> Show SelectOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectOptions -> ShowS
showsPrec :: Int -> SelectOptions -> ShowS
$cshow :: SelectOptions -> String
show :: SelectOptions -> String
$cshowList :: [SelectOptions] -> ShowS
showList :: [SelectOptions] -> ShowS
Show, SelectOptions -> SelectOptions -> Bool
(SelectOptions -> SelectOptions -> Bool)
-> (SelectOptions -> SelectOptions -> Bool) -> Eq SelectOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectOptions -> SelectOptions -> Bool
== :: SelectOptions -> SelectOptions -> Bool
$c/= :: SelectOptions -> SelectOptions -> Bool
/= :: SelectOptions -> SelectOptions -> Bool
Eq, (forall x. SelectOptions -> Rep SelectOptions x)
-> (forall x. Rep SelectOptions x -> SelectOptions)
-> Generic SelectOptions
forall x. Rep SelectOptions x -> SelectOptions
forall x. SelectOptions -> Rep SelectOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SelectOptions -> Rep SelectOptions x
from :: forall x. SelectOptions -> Rep SelectOptions x
$cto :: forall x. Rep SelectOptions x -> SelectOptions
to :: forall x. Rep SelectOptions x -> SelectOptions
Generic)


stringToGqlTypeName :: Text -> GqlTypeName
stringToGqlTypeName :: Text -> GqlTypeName
stringToGqlTypeName Text
name = GqlTypeName{$sel:full:GqlTypeName :: Text
full = Text
name, $sel:root:GqlTypeName :: Text
root = Text
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 :: Text -> Maybe Text -> Maybe GqlTypeName
sqlTypeNameToGQLTypeName Text
sqliteType Maybe Text
typeNameMb =
  let
    containsText :: Text -> Bool
containsText Text
text =
      Text -> Text -> Bool
isInfixOf Text
text (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
toUpper Text
sqliteType

    rootType :: Maybe Text
rootType
      -- If it is a view, column might not have a type
      | Text
sqliteType Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"" = Maybe Text
forall a. Maybe a
Nothing
      | Text -> Bool
containsText Text
"INT" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Int"
      | Text -> Bool
containsText Text
"CHAR" Bool -> Bool -> Bool
|| Text -> Bool
containsText Text
"CLOB" Bool -> Bool -> Bool
|| Text -> Bool
containsText Text
"TEXT" =
          Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"String"
      | Text -> Bool
containsText Text
"BLOB" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"String"
      | Text -> Bool
containsText Text
"REAL" Bool -> Bool -> Bool
|| Text -> Bool
containsText Text
"FLOA" Bool -> Bool -> Bool
|| Text -> Bool
containsText Text
"DOUB" =
          Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Float"
      | Text -> Bool
containsText Text
"BOOL" = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Boolean"
      | Bool
otherwise = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Int"
  in
    Maybe Text
rootType Maybe Text -> (Text -> GqlTypeName) -> Maybe GqlTypeName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
root ->
      GqlTypeName
        { $sel:root:GqlTypeName :: Text
root = Text
root
        , $sel:full:GqlTypeName :: Text
full = case Maybe Text
typeNameMb of
            P.Just Text
typeName -> Text -> Text
doubleXEncodeGql (Text
typeName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
root)
            Maybe Text
P.Nothing -> Text
root
        }


sqlDataToText :: SQLData -> Text
sqlDataToText :: SQLData -> Text
sqlDataToText = \case
  SQLInteger Int64
int64 -> Int64 -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Int64
int64
  SQLFloat Double
double -> Double -> Text
forall a b. (Show a, StringConv String b) => a -> b
show Double
double
  SQLText Text
text -> Text
text
  SQLBlob ByteString
_ -> Text
"BLOB"
  SQLData
SQLNull -> Text
"NULL"


-- | WARNING: Also change duplicate `sqlDataToGQLValue`
sqlDataToAesonValue :: Text -> SQLData -> Value
sqlDataToAesonValue :: Text -> SQLData -> Value
sqlDataToAesonValue Text
datatype SQLData
sqlData = case SQLData
sqlData of
  SQLInteger Int64
int64 ->
    if Text -> Text -> Bool
isInfixOf Text
"BOOL" (Text -> Bool) -> Text -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> Text
toUpper Text
datatype
      then case Int64
int64 of
        Int64
0 -> Bool -> Value
Bool Bool
False
        Int64
_ -> Bool -> Value
Bool Bool
True
      else Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Scientific
forall a b. (Integral a, Num b) => a -> b
P.fromIntegral Int64
int64 -- Int32
  SQLFloat Double
double -> Scientific -> Value
Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits Double
double
  SQLText Text
text -> Text -> Value
String Text
text
  SQLBlob ByteString
byteString -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
forall a b. (Show a, StringConv String b) => a -> b
show ByteString
byteString
  SQLData
SQLNull -> Value
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 :: Text -> Text -> Text -> Text
replaceCaseInsensitive Text
removable Text
replacement Text
txt =
  let
    len :: Int
len = Text -> Int
T.length Text
removable
    process :: Text -> Text -> Text
process Text
remaining Text
result
      | Text -> Bool
T.null Text
remaining = Text
result
      | (Text
remaining Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.take Int
len Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.toLower) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== (Text
removable Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text
T.toLower) =
          Text -> Text -> Text
process (Text
remaining Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.drop Int
len) (Text
result Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
replacement)
      | Bool
otherwise =
          Text -> Text -> Text
process (Text
remaining Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Int -> Text -> Text
T.drop Int
1) (Text
result Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.take Int
1 Text
remaining)
  in
    Text -> Text -> Text
process Text
txt Text
""


{-| Replace rem(movable) with rep(lacement)
| and make sure its surrounded by spaces
-}
replaceWithSpace :: Text -> Text -> Text -> Text
replaceWithSpace :: Text -> Text -> Text -> Text
replaceWithSpace Text
rem Text
rep Text
txt =
  Text
txt
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ")
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rem Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") (Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rep Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n")


sanitizeSql :: Text -> Text
sanitizeSql :: Text -> Text
sanitizeSql Text
sql =
  Text
sql
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/27
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"if not exists" Text
""
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/37
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"insert or abort " Text
"insert "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"insert or fail " Text
"insert "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"insert or ignore " Text
"insert "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"insert or replace " Text
"insert "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"insert or rollback " Text
"insert "
    -- Removing the JSON arrow operator seems to be enough
    -- to make the parser accept all queries containing JSON operators
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"->" Text
""
    -- https://www.sqlite.org/stricttables.html
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
")strict" Text
")"
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
") strict" Text
")"
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
")\nstrict" Text
")"
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
") \nstrict" Text
")"
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/20
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ( \Text
sqlQuery ->
          if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.all
            (\Text
word -> Text
word Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` Text -> [Text]
T.words (Text -> Text
T.toLower Text
sqlQuery))
            [Text
"alter", Text
"table", Text
"rename"]
            then Text
"SELECT 0" -- Dummy statement to accept the query
            else Text
sqlQuery
      )
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/41
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& ( \Text
sqlQuery ->
          if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
P.all
            (\Text
word -> Text
word Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`P.elem` Text -> [Text]
T.words (Text -> Text
T.toLower Text
sqlQuery))
            [Text
"create", Text
"trigger", Text
"on", Text
"begin", Text
"end"]
            then Text
"SELECT 0" -- Dummy statement to accept the query
            else Text
sqlQuery
      )
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"drop trigger" Text
"drop table"
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"drop index" Text
"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
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
")returning " Text
") -- returning "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
") returning " Text
") -- returning "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
")\nreturning " Text
")\n-- returning "
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
") \nreturning " Text
")\n-- returning "
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/43
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"==" Text
"="
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"is not" Text
"%$@_TEMP_@$%"
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"is" Text
"="
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"%$@_TEMP_@$%" Text
"is not"
    -- The internal table is created without column types
    -- TODO: Remove after
    -- https://github.com/JakeWheat/simple-sql-parser/issues/38#issuecomment-1413340116
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive
      Text
"sqlite_sequence(name,seq)"
      Text
"sqlite_sequence(name TEXT,seq INT)"
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/40
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"NOT NULL DEFAULT" Text
"DEFAULT"
    -- TODO: Remove after
    --       https://github.com/JakeWheat/simple-sql-parser/issues/46
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"STORED" Text
""
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceCaseInsensitive Text
"VIRTUAL" Text
""
    Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
replaceWithSpace Text
"GLOB" Text
"LIKE"


-- | SQLite dialect
sqlite :: Dialect
sqlite :: Dialect
sqlite =
  Dialect
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"
        , "current_date"
        , "current_time"
        , "current_timestamp"
        , "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
    }


parseSql :: Text -> P.Either ParseError Statement
parseSql :: Text -> Either ParseError Statement
parseSql Text
sqlQuery =
  Dialect
-> String
-> Maybe (Int, Int)
-> String
-> Either ParseError Statement
parseStatement Dialect
sqlite String
"" Maybe (Int, Int)
forall a. Maybe a
P.Nothing (String -> Either ParseError Statement)
-> String -> Either ParseError Statement
forall a b. (a -> b) -> a -> b
$
    Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
      Text -> Text
sanitizeSql Text
sqlQuery


newtype SQLPost = SQLPost
  { SQLPost -> Text
query :: Text
  }
  deriving (SQLPost -> SQLPost -> Bool
(SQLPost -> SQLPost -> Bool)
-> (SQLPost -> SQLPost -> Bool) -> Eq SQLPost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SQLPost -> SQLPost -> Bool
== :: SQLPost -> SQLPost -> Bool
$c/= :: SQLPost -> SQLPost -> Bool
/= :: SQLPost -> SQLPost -> Bool
Eq, Int -> SQLPost -> ShowS
[SQLPost] -> ShowS
SQLPost -> String
(Int -> SQLPost -> ShowS)
-> (SQLPost -> String) -> ([SQLPost] -> ShowS) -> Show SQLPost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SQLPost -> ShowS
showsPrec :: Int -> SQLPost -> ShowS
$cshow :: SQLPost -> String
show :: SQLPost -> String
$cshowList :: [SQLPost] -> ShowS
showList :: [SQLPost] -> ShowS
Show, (forall x. SQLPost -> Rep SQLPost x)
-> (forall x. Rep SQLPost x -> SQLPost) -> Generic SQLPost
forall x. Rep SQLPost x -> SQLPost
forall x. SQLPost -> Rep SQLPost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SQLPost -> Rep SQLPost x
from :: forall x. SQLPost -> Rep SQLPost x
$cto :: forall x. Rep SQLPost x -> SQLPost
to :: forall x. Rep SQLPost x -> SQLPost
Generic)


instance ToJSON SQLPost
instance FromJSON SQLPost


instance ToSample AirGQL.Lib.SQLPost where
  toSamples :: Proxy SQLPost -> [(Text, SQLPost)]
toSamples Proxy SQLPost
_ = SQLPost -> [(Text, SQLPost)]
forall a. a -> [(Text, a)]
singleSample (SQLPost -> [(Text, SQLPost)]) -> SQLPost -> [(Text, SQLPost)]
forall a b. (a -> b) -> a -> b
$ Text -> SQLPost
SQLPost Text
"SELECT * FROM users"