{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
{-# LANGUAGE TupleSections #-}

-- | Migrations support for SQLite databases
module Database.Beam.Sqlite.Migrate
  ( -- * @beam-migrate@ CLI support
    migrationBackend, SqliteCommandSyntax

    -- * @beam-migrate@ utility functions
  , migrateScript, writeMigrationScript
  , sqlitePredConverter, sqliteTypeToHs
  , getDbConstraints

    -- * SQLite-specific data types
  , sqliteText, sqliteBlob, sqliteBigInt
  ) where

import qualified Database.Beam.Migrate as Db
import qualified Database.Beam.Migrate.Backend as Tool
import qualified Database.Beam.Migrate.Serialization as Db
import           Database.Beam.Migrate.Types (QualifiedName(..))
import qualified Database.Beam.Query.DataTypes as Db

import           Database.Beam.Backend.SQL
import           Database.Beam.Haskell.Syntax
import           Database.Beam.Sqlite.Connection
import           Database.Beam.Sqlite.Syntax

import           Control.Applicative
import           Control.Exception
import           Control.Monad.Reader

import           Database.SQLite.Simple (open, close, query_)

import           Data.Aeson
import           Data.Attoparsec.Text (asciiCI, skipSpace)
import qualified Data.Attoparsec.Text as A
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as BL
import           Data.Char (isSpace)
import           Data.Int (Int64)
import           Data.List (sortBy)
import           Data.Maybe (mapMaybe, isJust)
import           Data.Monoid (Endo(..))
import           Data.Ord (comparing)
import           Data.String (fromString)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE

-- | Top-level 'Tool.BeamMigrationBackend' loaded dynamically by the
-- @beam-migrate@ CLI tool.
migrationBackend :: Tool.BeamMigrationBackend Sqlite SqliteM
migrationBackend :: BeamMigrationBackend Sqlite SqliteM
migrationBackend = String
-> String
-> SqliteM [SomeDatabasePredicate]
-> BeamDeserializers Sqlite
-> (BeamSqlBackendSyntax Sqlite -> String)
-> String
-> HaskellPredicateConverter
-> ActionProvider Sqlite
-> (forall a. String -> SqliteM a -> IO (Either String a))
-> BeamMigrationBackend Sqlite SqliteM
forall be (m :: * -> *).
(MonadBeam be m, MonadFail m, HasQBuilder be,
 BeamMigrateSqlBackend be,
 HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be),
 BeamSqlBackendCanSerialize be LocalTime,
 BeamSqlBackendCanSerialize be (Maybe LocalTime),
 BeamSqlBackendCanSerialize be Text,
 BeamSqlBackendCanSerialize be SqlNull,
 Sql92ReasonableMarshaller be) =>
String
-> String
-> m [SomeDatabasePredicate]
-> BeamDeserializers be
-> (BeamSqlBackendSyntax be -> String)
-> String
-> HaskellPredicateConverter
-> ActionProvider be
-> (forall a. String -> m a -> IO (Either String a))
-> BeamMigrationBackend be m
Tool.BeamMigrationBackend
                       String
"sqlite"
                       String
"For beam-sqlite, this is the path to a sqlite3 file"
                       SqliteM [SomeDatabasePredicate]
getDbConstraints
                       (BeamDeserializers Sqlite
forall be. BeamMigrateSqlBackend be => BeamDeserializers be
Db.sql92Deserializers BeamDeserializers Sqlite
-> BeamDeserializers Sqlite -> BeamDeserializers Sqlite
forall a. Semigroup a => a -> a -> a
<> BeamDeserializers Sqlite
sqliteDataTypeDeserializers BeamDeserializers Sqlite
-> BeamDeserializers Sqlite -> BeamDeserializers Sqlite
forall a. Semigroup a => a -> a -> a
<>
                        BeamDeserializers Sqlite
forall be.
(Typeable be, BeamMigrateOnlySqlBackend be,
 HasDataTypeCreatedCheck
   (BeamMigrateSqlBackendDataTypeSyntax be)) =>
BeamDeserializers be
Db.beamCheckDeserializers)
                       (ByteString -> String
BL.unpack (ByteString -> String)
-> (SqliteCommandSyntax -> ByteString)
-> SqliteCommandSyntax
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";") (ByteString -> ByteString)
-> (SqliteCommandSyntax -> ByteString)
-> SqliteCommandSyntax
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteSyntax -> ByteString
sqliteRenderSyntaxScript (SqliteSyntax -> ByteString)
-> (SqliteCommandSyntax -> SqliteSyntax)
-> SqliteCommandSyntax
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteCommandSyntax -> SqliteSyntax
fromSqliteCommand)
                       String
"sqlite.sql"
                       HaskellPredicateConverter
sqlitePredConverter ActionProvider Sqlite
forall be.
(Typeable be, BeamMigrateOnlySqlBackend be) =>
ActionProvider be
Db.defaultActionProvider
                       (\String
fp SqliteM a
action ->
                            IO Connection
-> (Connection -> IO ())
-> (Connection -> IO (Either String a))
-> IO (Either String a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> IO Connection
open String
fp) Connection -> IO ()
close ((Connection -> IO (Either String a)) -> IO (Either String a))
-> (Connection -> IO (Either String a)) -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
                              IO (Either String a)
-> (SomeException -> IO (Either String a)) -> IO (Either String a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (a -> Either String a
forall a b. b -> Either a b
Right (a -> Either String a) -> IO a -> IO (Either String a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (String -> IO (), Connection) IO a
-> (String -> IO (), Connection) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SqliteM a -> ReaderT (String -> IO (), Connection) IO a
forall a. SqliteM a -> ReaderT (String -> IO (), Connection) IO a
runSqliteM SqliteM a
action)
                                                          (\String
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure (), Connection
conn))
                                    (\SomeException
e -> Either String a -> IO (Either String a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Either String a
forall a b. a -> Either a b
Left (SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)))))

-- | 'Db.BeamDeserializers' or SQLite specific types. Specifically,
-- 'sqliteBlob', 'sqliteText', and 'sqliteBigInt'. These are compatible with the
-- "typical" serialized versions of the standard 'Db.binaryLargeObject',
-- 'Db.characterLargeObject', and 'Db.bigint' types.
sqliteDataTypeDeserializers :: Db.BeamDeserializers Sqlite
sqliteDataTypeDeserializers :: BeamDeserializers Sqlite
sqliteDataTypeDeserializers =
  (forall be'.
 BeamDeserializers be' -> Value -> Parser SqliteDataTypeSyntax)
-> BeamDeserializers Sqlite
forall ty be.
Typeable ty =>
(forall be'. BeamDeserializers be' -> Value -> Parser ty)
-> BeamDeserializers be
Db.beamDeserializer ((forall be'.
  BeamDeserializers be' -> Value -> Parser SqliteDataTypeSyntax)
 -> BeamDeserializers Sqlite)
-> (forall be'.
    BeamDeserializers be' -> Value -> Parser SqliteDataTypeSyntax)
-> BeamDeserializers Sqlite
forall a b. (a -> b) -> a -> b
$ \BeamDeserializers be'
_ Value
v ->
  (SqliteDataTypeSyntax -> SqliteDataTypeSyntax)
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SqliteDataTypeSyntax -> SqliteDataTypeSyntax
forall a. a -> a
id @SqliteDataTypeSyntax) (Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax)
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall a b. (a -> b) -> a -> b
$
  case Value
v of
    Value
"blob" -> SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
sqliteBlobType
    Value
"clob" -> SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
sqliteTextType
    Value
"bigint" -> SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
sqliteBigIntType
    Object Object
o ->
       ((Maybe Word -> SqliteDataTypeSyntax)
-> Parser (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Word
_ :: Maybe Word) -> SqliteDataTypeSyntax
sqliteBlobType) (Object
o Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"binary")) Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
       ((Maybe Word -> SqliteDataTypeSyntax)
-> Parser (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Maybe Word
_ :: Maybe Word) -> SqliteDataTypeSyntax
sqliteBlobType) (Object
o Object -> Text -> Parser (Maybe Word)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"varbinary"))
    Value
_ -> String -> Parser SqliteDataTypeSyntax
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not parse sqlite-specific data type"

-- | Render a series of 'Db.MigrationSteps' in the 'SqliteCommandSyntax' into a
-- line-by-line list of lazy 'BL'ByteString's. The output is suitable for
-- inclusion in a migration script. Comments are generated giving a description
-- of each migration step.
migrateScript :: Db.MigrationSteps Sqlite () a -> [BL.ByteString]
migrateScript :: MigrationSteps Sqlite () a -> [ByteString]
migrateScript MigrationSteps Sqlite () a
steps =
  ByteString
"-- Generated by beam-sqlite beam-migrate backend\n" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  ByteString
"\n" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:
  Endo [ByteString] -> [ByteString] -> [ByteString]
forall a. Endo a -> a -> a
appEndo ((Text -> Endo [ByteString])
-> (BeamSqlBackendSyntax Sqlite -> Endo [ByteString])
-> MigrationSteps Sqlite () a
-> Endo [ByteString]
forall be m a.
(Monoid m, Semigroup m, BeamSqlBackend be) =>
(Text -> m)
-> (BeamSqlBackendSyntax be -> m) -> MigrationSteps be () a -> m
Db.migrateScript Text -> Endo [ByteString]
renderHeader BeamSqlBackendSyntax Sqlite -> Endo [ByteString]
SqliteCommandSyntax -> Endo [ByteString]
renderCommand MigrationSteps Sqlite () a
steps) []
  where
    renderHeader :: Text -> Endo [ByteString]
renderHeader Text
nm =
      ([ByteString] -> [ByteString]) -> Endo [ByteString]
forall a. (a -> a) -> Endo a
Endo ((ByteString
"-- " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BL.fromStrict (Text -> ByteString
TE.encodeUtf8 Text
nm) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\n")ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)
    renderCommand :: SqliteCommandSyntax -> Endo [ByteString]
renderCommand SqliteCommandSyntax
cmd =
      ([ByteString] -> [ByteString]) -> Endo [ByteString]
forall a. (a -> a) -> Endo a
Endo ((SqliteSyntax -> ByteString
sqliteRenderSyntaxScript (SqliteCommandSyntax -> SqliteSyntax
fromSqliteCommand SqliteCommandSyntax
cmd) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
";\n")ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:)

-- | Write the output of 'migrateScript' to a file
writeMigrationScript :: FilePath -> Db.MigrationSteps Sqlite () a -> IO ()
writeMigrationScript :: String -> MigrationSteps Sqlite () a -> IO ()
writeMigrationScript String
fp MigrationSteps Sqlite () a
steps =
  let stepBs :: [ByteString]
stepBs = MigrationSteps Sqlite () a -> [ByteString]
forall a. MigrationSteps Sqlite () a -> [ByteString]
migrateScript MigrationSteps Sqlite () a
steps
  in String -> ByteString -> IO ()
BL.writeFile String
fp ([ByteString] -> ByteString
BL.concat [ByteString]
stepBs)

-- | 'Tool.HaskellPredicateConverter' that can convert all constraints generated
-- by 'getDbConstaints' into their equivalent in the @beam-migrate@ haskell
-- syntax. Suitable for auto-generation of a haskell migration.
sqlitePredConverter :: Tool.HaskellPredicateConverter
sqlitePredConverter :: HaskellPredicateConverter
sqlitePredConverter = (BeamMigrateSqlBackendDataTypeSyntax Sqlite -> Maybe HsDataType)
-> HaskellPredicateConverter
forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
Tool.sql92HsPredicateConverters @Sqlite BeamMigrateSqlBackendDataTypeSyntax Sqlite -> Maybe HsDataType
SqliteDataTypeSyntax -> Maybe HsDataType
sqliteTypeToHs HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
forall a. Semigroup a => a -> a -> a
<>
                      (TableColumnHasConstraint Sqlite -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall pred.
Typeable pred =>
(pred -> Maybe SomeDatabasePredicate) -> HaskellPredicateConverter
Tool.hsPredicateConverter TableColumnHasConstraint Sqlite -> Maybe SomeDatabasePredicate
sqliteHasColumnConstraint
  where
    sqliteHasColumnConstraint :: TableColumnHasConstraint Sqlite -> Maybe SomeDatabasePredicate
sqliteHasColumnConstraint (Db.TableColumnHasConstraint QualifiedName
tblNm Text
colNm BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite
c ::
                                  Db.TableColumnHasConstraint Sqlite)
      | BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite
SqliteColumnConstraintDefinitionSyntax
c SqliteColumnConstraintDefinitionSyntax
-> SqliteColumnConstraintDefinitionSyntax -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     SqliteColumnConstraintDefinitionSyntax
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        SqliteColumnConstraintDefinitionSyntax)
-> SqliteColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  SqliteColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     SqliteColumnConstraintDefinitionSyntax)
forall a. Maybe a
Nothing =
        SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just (TableColumnHasConstraint HsMigrateBackend -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax HsMigrateBackend
-> TableColumnHasConstraint HsMigrateBackend
forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint QualifiedName
tblNm Text
colNm (Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     HsConstraintDefinition
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        HsConstraintDefinition)
-> HsConstraintDefinition
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  HsConstraintDefinition
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     HsConstraintDefinition)
forall a. Maybe a
Nothing) ::
                                           Db.TableColumnHasConstraint HsMigrateBackend))
      | Bool
otherwise = Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing

-- | Convert a SQLite data type to the corresponding Haskell one
sqliteTypeToHs :: SqliteDataTypeSyntax
               -> Maybe HsDataType
sqliteTypeToHs :: SqliteDataTypeSyntax -> Maybe HsDataType
sqliteTypeToHs = HsDataType -> Maybe HsDataType
forall a. a -> Maybe a
Just (HsDataType -> Maybe HsDataType)
-> (SqliteDataTypeSyntax -> HsDataType)
-> SqliteDataTypeSyntax
-> Maybe HsDataType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SqliteDataTypeSyntax -> HsDataType
sqliteDataTypeToHs

parseSqliteDataType :: T.Text -> SqliteDataTypeSyntax
parseSqliteDataType :: Text -> SqliteDataTypeSyntax
parseSqliteDataType Text
txt =
  case Parser SqliteDataTypeSyntax
-> Text -> Either String SqliteDataTypeSyntax
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser SqliteDataTypeSyntax
dtParser Text
txt of
    Left {} -> SqliteSyntax
-> HsDataType
-> BeamSerializedDataType
-> Bool
-> SqliteDataTypeSyntax
SqliteDataTypeSyntax (ByteString -> SqliteSyntax
emit (Text -> ByteString
TE.encodeUtf8 Text
txt))
                                    (String -> HsDataType
hsErrorType (String
"Unknown SQLite datatype '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
txt String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"))
                                    (Value -> BeamSerializedDataType
Db.BeamSerializedDataType (Value -> BeamSerializedDataType)
-> Value -> BeamSerializedDataType
forall a b. (a -> b) -> a -> b
$
                                     Text -> Value -> Value
Db.beamSerializeJSON Text
"sqlite"
                                       (Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
txt))
                                    Bool
False
    Right SqliteDataTypeSyntax
x -> SqliteDataTypeSyntax
x
  where
    dtParser :: Parser SqliteDataTypeSyntax
dtParser = Parser SqliteDataTypeSyntax
charP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
varcharP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
ncharP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
nvarcharP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
bitP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
varbitP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
numericP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
decimalP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
doubleP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
integerP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
smallIntP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
bigIntP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
floatP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
doubleP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
realP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
dateP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
timestampP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
timeP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
textP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
               Parser SqliteDataTypeSyntax
blobP Parser SqliteDataTypeSyntax
-> Parser SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser SqliteDataTypeSyntax
booleanP

    ws :: Parser Text String
ws = Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.space

    characterP :: Parser Text Text
characterP = Text -> Parser Text Text
asciiCI Text
"CHARACTER" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
asciiCI Text
"CHAR"
    characterVaryingP :: Parser Text Text
characterVaryingP = Parser Text Text
characterP Parser Text Text -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text Text
asciiCI Text
"VARYING"
    charP :: Parser SqliteDataTypeSyntax
charP = do
      Parser Text Text
characterP
      Maybe Word -> Maybe Text -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
charType (Maybe Word -> Maybe Text -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word)
-> Parser Text (Maybe Text -> SqliteDataTypeSyntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP Parser Text (Maybe Text -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Text) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Maybe Text)
charSetP
    varcharP :: Parser SqliteDataTypeSyntax
varcharP = do
      Text -> Parser Text Text
asciiCI Text
"VARCHAR" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
characterVaryingP
      Maybe Word -> Maybe Text -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Maybe Text -> dataType
varCharType (Maybe Word -> Maybe Text -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word)
-> Parser Text (Maybe Text -> SqliteDataTypeSyntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP Parser Text (Maybe Text -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Text) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Maybe Text)
charSetP
    ncharP :: Parser SqliteDataTypeSyntax
ncharP = do
      Text -> Parser Text Text
asciiCI Text
"NATIONAL"
      Parser Text String
ws
      Parser Text Text
characterP
      Maybe Word -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
nationalCharType (Maybe Word -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP
    nvarcharP :: Parser SqliteDataTypeSyntax
nvarcharP = do
      Text -> Parser Text Text
asciiCI Text
"NVARCHAR" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
asciiCI Text
"NATIONAL" Parser Text Text -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
characterVaryingP)
      Maybe Word -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
nationalVarCharType (Maybe Word -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP
    bitP :: Parser SqliteDataTypeSyntax
bitP = do
      Text -> Parser Text Text
asciiCI Text
"BIT"
      Maybe Word -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
bitType (Maybe Word -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP
    varbitP :: Parser SqliteDataTypeSyntax
varbitP = do
      Text -> Parser Text Text
asciiCI Text
"VARBIT" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
asciiCI Text
"BIT" Parser Text Text -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text Text
asciiCI Text
"VARYING")
      Maybe Word -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
varBitType (Maybe Word -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP

    numericP :: Parser SqliteDataTypeSyntax
numericP = do
      Text -> Parser Text Text
asciiCI Text
"NUMERIC"
      Maybe (Word, Maybe Word) -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
numericType (Maybe (Word, Maybe Word) -> SqliteDataTypeSyntax)
-> Parser Text (Maybe (Word, Maybe Word))
-> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe (Word, Maybe Word))
numericPrecP
    decimalP :: Parser SqliteDataTypeSyntax
decimalP = do
      Text -> Parser Text Text
asciiCI Text
"DECIMAL"
      Maybe (Word, Maybe Word) -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe (Word, Maybe Word) -> dataType
decimalType (Maybe (Word, Maybe Word) -> SqliteDataTypeSyntax)
-> Parser Text (Maybe (Word, Maybe Word))
-> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe (Word, Maybe Word))
numericPrecP
    floatP :: Parser SqliteDataTypeSyntax
floatP = do
      Text -> Parser Text Text
asciiCI Text
"FLOAT"
      Maybe Word -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> dataType
floatType (Maybe Word -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word) -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP
    doubleP :: Parser SqliteDataTypeSyntax
doubleP = do
      Text -> Parser Text Text
asciiCI Text
"DOUBLE"
      Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text Text -> Parser Text (Maybe Text))
-> Parser Text Text -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text Text
asciiCI Text
"PRECISION"
      SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
doubleType
    realP :: Parser SqliteDataTypeSyntax
realP = SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
realType SqliteDataTypeSyntax
-> Parser Text Text -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
asciiCI Text
"REAL"

    intTypeP :: Parser Text Text
intTypeP =
      Text -> Parser Text Text
asciiCI Text
"INT" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
asciiCI Text
"INTEGER"
    integerP :: Parser SqliteDataTypeSyntax
integerP = do
      Parser Text Text
intTypeP
      SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
intType
    smallIntP :: Parser SqliteDataTypeSyntax
smallIntP = do
      Text -> Parser Text Text
asciiCI Text
"INT2" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
asciiCI Text
"SMALL" Parser Text Text
-> Parser Text (Maybe String) -> Parser Text (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String -> Parser Text (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text String
ws Parser Text (Maybe String) -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
intTypeP)
      SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
smallIntType
    bigIntP :: Parser SqliteDataTypeSyntax
bigIntP = do
      Text -> Parser Text Text
asciiCI Text
"INT8" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Text -> Parser Text Text
asciiCI Text
"BIG" Parser Text Text
-> Parser Text (Maybe String) -> Parser Text (Maybe String)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String -> Parser Text (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text String
ws Parser Text (Maybe String) -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text Text
intTypeP)
      SqliteDataTypeSyntax -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqliteDataTypeSyntax
sqliteBigIntType
    dateP :: Parser SqliteDataTypeSyntax
dateP = SqliteDataTypeSyntax
forall dataType. IsSql92DataTypeSyntax dataType => dataType
dateType SqliteDataTypeSyntax
-> Parser Text Text -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
asciiCI Text
"DATE"
    timeP :: Parser SqliteDataTypeSyntax
timeP = do
      Text -> Parser Text Text
asciiCI Text
"TIME"
      Maybe Word -> Bool -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timeType (Maybe Word -> Bool -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word)
-> Parser Text (Bool -> SqliteDataTypeSyntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP Parser Text (Bool -> SqliteDataTypeSyntax)
-> Parser Text Bool -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Bool
timezoneP
    timestampP :: Parser SqliteDataTypeSyntax
timestampP = do
      Text -> Parser Text Text
asciiCI Text
"TIMESTAMP"
      Maybe Word -> Bool -> SqliteDataTypeSyntax
forall dataType.
IsSql92DataTypeSyntax dataType =>
Maybe Word -> Bool -> dataType
timestampType (Maybe Word -> Bool -> SqliteDataTypeSyntax)
-> Parser Text (Maybe Word)
-> Parser Text (Bool -> SqliteDataTypeSyntax)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text (Maybe Word)
precP Parser Text (Bool -> SqliteDataTypeSyntax)
-> Parser Text Bool -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Bool
timezoneP
    textP :: Parser SqliteDataTypeSyntax
textP = SqliteDataTypeSyntax
sqliteTextType SqliteDataTypeSyntax
-> Parser Text Text -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
asciiCI Text
"TEXT"
    blobP :: Parser SqliteDataTypeSyntax
blobP = SqliteDataTypeSyntax
sqliteBlobType SqliteDataTypeSyntax
-> Parser Text Text -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Text -> Parser Text Text
asciiCI Text
"BLOB"

    booleanP :: Parser SqliteDataTypeSyntax
booleanP = SqliteDataTypeSyntax
forall dataType. IsSql99DataTypeSyntax dataType => dataType
booleanType SqliteDataTypeSyntax
-> Parser Text Text -> Parser SqliteDataTypeSyntax
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (Text -> Parser Text Text
asciiCI Text
"BOOL" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
asciiCI Text
"BOOLEAN")

    timezoneP :: Parser Text Bool
timezoneP = (Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                 Text -> Parser Text Text
asciiCI Text
"WITH" Parser Text Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                 (Text -> Parser Text Text
asciiCI Text
"TIMEZONE" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                  (Text -> Parser Text Text
asciiCI Text
"TIME" Parser Text Text -> Parser Text String -> Parser Text String
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                   Text -> Parser Text Text
asciiCI Text
"ZONE")) Parser Text Text -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                 Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Parser Text Bool -> Parser Text Bool -> Parser Text Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                Bool -> Parser Text Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

    precP :: Parser Text (Maybe Word)
precP = Parser Text Word -> Parser Text (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpace Parser () -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
A.char Char
'(' Parser Text Char -> Parser Text Word -> Parser Text Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                      Parser Text Word
forall a. Integral a => Parser a
A.decimal Parser Text Word -> Parser Text Char -> Parser Text Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
')')
    numericPrecP :: Parser Text (Maybe (Word, Maybe Word))
numericPrecP = Parser Text (Word, Maybe Word)
-> Parser Text (Maybe (Word, Maybe Word))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((,) (Word -> Maybe Word -> (Word, Maybe Word))
-> Parser Text Word
-> Parser Text (Maybe Word -> (Word, Maybe Word))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser ()
skipSpace Parser () -> Parser Text Char -> Parser Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text Char
A.char Char
'(' Parser Text Char -> Parser Text Word -> Parser Text Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                                      Parser Text Word
forall a. Integral a => Parser a
A.decimal)
                                 Parser Text (Maybe Word -> (Word, Maybe Word))
-> Parser Text (Maybe Word) -> Parser Text (Word, Maybe Word)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ()
skipSpace Parser () -> Parser Text (Maybe Word) -> Parser Text (Maybe Word)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                                      Parser Text Word -> Parser Text (Maybe Word)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Text Char
A.char Char
',' Parser Text Char -> Parser () -> Parser ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
skipSpace Parser () -> Parser Text Word -> Parser Text Word
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                                                 Parser Text Word
forall a. Integral a => Parser a
A.decimal) Parser Text (Maybe Word) -> Parser () -> Parser Text (Maybe Word)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
                                      Parser ()
skipSpace Parser Text (Maybe Word)
-> Parser Text Char -> Parser Text (Maybe Word)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Text Char
A.char Char
')'))

    charSetP :: Parser Text (Maybe Text)
charSetP = Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser ()
skipSpace Parser () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                         Text -> Parser Text Text
asciiCI Text
"CHARACTER" Parser Text Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                         Text -> Parser Text Text
asciiCI Text
"SET" Parser Text Text -> Parser Text String -> Parser Text String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text String
ws Parser Text String -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
                         (Char -> Bool) -> Parser Text Text
A.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace))

-- TODO constraints and foreign keys

-- | Get a list of database predicates for the current database. This is beam's
-- best guess at providing a schema for the current database. Note that SQLite
-- type names are not standardized, and the so-called column "affinities" are
-- too broad to be of use. This function attemps to guess a good enough type
-- based on the exact type supplied in the @CREATE TABLE@ commands. It will
-- correctly parse any type generated by beam and most SQL compliant types, but
-- it may falter on databases created or managed by tools that do not follow
-- these standards.
getDbConstraints :: SqliteM [Db.SomeDatabasePredicate]
getDbConstraints :: SqliteM [SomeDatabasePredicate]
getDbConstraints =
  ReaderT (String -> IO (), Connection) IO [SomeDatabasePredicate]
-> SqliteM [SomeDatabasePredicate]
forall a. ReaderT (String -> IO (), Connection) IO a -> SqliteM a
SqliteM (ReaderT (String -> IO (), Connection) IO [SomeDatabasePredicate]
 -> SqliteM [SomeDatabasePredicate])
-> (((String -> IO (), Connection) -> IO [SomeDatabasePredicate])
    -> ReaderT
         (String -> IO (), Connection) IO [SomeDatabasePredicate])
-> ((String -> IO (), Connection) -> IO [SomeDatabasePredicate])
-> SqliteM [SomeDatabasePredicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> IO (), Connection) -> IO [SomeDatabasePredicate])
-> ReaderT (String -> IO (), Connection) IO [SomeDatabasePredicate]
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (((String -> IO (), Connection) -> IO [SomeDatabasePredicate])
 -> SqliteM [SomeDatabasePredicate])
-> ((String -> IO (), Connection) -> IO [SomeDatabasePredicate])
-> SqliteM [SomeDatabasePredicate]
forall a b. (a -> b) -> a -> b
$ \(String -> IO ()
_, Connection
conn) -> do
    [(Text, Text)]
tblNames <- Connection -> Query -> IO [(Text, Text)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
"SELECT name, sql from sqlite_master where type='table'"
    [SomeDatabasePredicate]
tblPreds <-
      ([[SomeDatabasePredicate]] -> [SomeDatabasePredicate])
-> IO [[SomeDatabasePredicate]] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[SomeDatabasePredicate]] -> [SomeDatabasePredicate]
forall a. Monoid a => [a] -> a
mconcat (IO [[SomeDatabasePredicate]] -> IO [SomeDatabasePredicate])
-> (((Text, Text) -> IO [SomeDatabasePredicate])
    -> IO [[SomeDatabasePredicate]])
-> ((Text, Text) -> IO [SomeDatabasePredicate])
-> IO [SomeDatabasePredicate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Text)]
-> ((Text, Text) -> IO [SomeDatabasePredicate])
-> IO [[SomeDatabasePredicate]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(Text, Text)]
tblNames (((Text, Text) -> IO [SomeDatabasePredicate])
 -> IO [SomeDatabasePredicate])
-> ((Text, Text) -> IO [SomeDatabasePredicate])
-> IO [SomeDatabasePredicate]
forall a b. (a -> b) -> a -> b
$ \(Text
tblNameStr, Text
sql) -> do
        let tblName :: QualifiedName
tblName = Maybe Text -> Text -> QualifiedName
QualifiedName Maybe Text
forall a. Maybe a
Nothing Text
tblNameStr
        [(Int, Text, Text, Bool, Maybe Text, Int)]
columns <- ([(Int, Text, Text, Bool, Maybe Text, Int)]
 -> [(Int, Text, Text, Bool, Maybe Text, Int)])
-> IO [(Int, Text, Text, Bool, Maybe Text, Int)]
-> IO [(Int, Text, Text, Bool, Maybe Text, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Int, Text, Text, Bool, Maybe Text, Int)
 -> (Int, Text, Text, Bool, Maybe Text, Int) -> Ordering)
-> [(Int, Text, Text, Bool, Maybe Text, Int)]
-> [(Int, Text, Text, Bool, Maybe Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, Text, Text, Bool, Maybe Text, Int) -> Int)
-> (Int, Text, Text, Bool, Maybe Text, Int)
-> (Int, Text, Text, Bool, Maybe Text, Int)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (\(Int
cid, Text
_, Text
_, Bool
_, Maybe Text
_, Int
_) -> Int
cid :: Int))) (IO [(Int, Text, Text, Bool, Maybe Text, Int)]
 -> IO [(Int, Text, Text, Bool, Maybe Text, Int)])
-> IO [(Int, Text, Text, Bool, Maybe Text, Int)]
-> IO [(Int, Text, Text, Bool, Maybe Text, Int)]
forall a b. (a -> b) -> a -> b
$
                   Connection
-> Query -> IO [(Int, Text, Text, Bool, Maybe Text, Int)]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn (String -> Query
forall a. IsString a => String -> a
fromString (String
"PRAGMA table_info('" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
tblNameStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"')"))

        let columnPreds :: [SomeDatabasePredicate]
columnPreds =
              ((Int, Text, Text, Bool, Maybe Text, Int)
 -> [SomeDatabasePredicate])
-> [(Int, Text, Text, Bool, Maybe Text, Int)]
-> [SomeDatabasePredicate]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap
                (\(Int
_ ::Int, Text
nm, Text
typStr, Bool
notNull, Maybe Text
_, Int
_) ->
                     let dtType :: SqliteDataTypeSyntax
dtType = if Bool
isAutoincrement then SqliteDataTypeSyntax
sqliteSerialType else Text -> SqliteDataTypeSyntax
parseSqliteDataType Text
typStr
                         isAutoincrement :: Bool
isAutoincrement = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Result String -> Maybe String
forall r. Result r -> Maybe r
A.maybeResult (Parser Text String -> Text -> Result String
forall a. Parser a -> Text -> Result a
A.parse Parser Text String
autoincrementParser Text
sql))

                         autoincrementParser :: Parser Text String
autoincrementParser = do
                           Parser Text Char -> Parser Text Text -> Parser Text String
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
A.manyTill Parser Text Char
A.anyChar (Parser Text Text -> Parser Text String)
-> Parser Text Text -> Parser Text String
forall a b. (a -> b) -> a -> b
$ do
                             Maybe Char
hadQuote <- Parser Text Char -> Parser Text (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Text Char
A.char Char
'"')
                             Text -> Parser Text Text
A.string Text
nm
                             Parser () -> (Char -> Parser ()) -> Maybe Char -> Parser ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Parser ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (\Char
_ -> Parser Text Char -> Parser ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Parser Text Char -> Parser ()) -> Parser Text Char -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Text Char
A.char Char
'"') Maybe Char
hadQuote
                             Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.space
                             Text -> Parser Text Text
asciiCI Text
"INTEGER"
                             Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.space
                             Text -> Parser Text Text
asciiCI Text
"PRIMARY"
                             Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.space
                             Text -> Parser Text Text
asciiCI Text
"KEY"
                             Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 Parser Text Char
A.space
                             Text -> Parser Text Text
asciiCI Text
"AUTOINCREMENT"

                         notNullPred :: [SomeDatabasePredicate]
notNullPred =
                           if Bool
notNull
                           then [ TableColumnHasConstraint Sqlite -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate
                                    (QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax Sqlite
-> TableColumnHasConstraint Sqlite
forall be.
QualifiedName
-> Text
-> BeamSqlBackendColumnConstraintDefinitionSyntax be
-> TableColumnHasConstraint be
Db.TableColumnHasConstraint QualifiedName
tblName Text
nm
                                       (Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax
     SqliteColumnConstraintDefinitionSyntax
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax
        SqliteColumnConstraintDefinitionSyntax)
-> SqliteColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintDefinitionSyntax constraint =>
Maybe Text
-> Sql92ColumnConstraintDefinitionConstraintSyntax constraint
-> Maybe
     (Sql92ColumnConstraintDefinitionAttributesSyntax constraint)
-> constraint
Db.constraintDefinitionSyntax Maybe Text
forall a. Maybe a
Nothing Sql92ColumnConstraintDefinitionConstraintSyntax
  SqliteColumnConstraintDefinitionSyntax
forall constraint.
IsSql92ColumnConstraintSyntax constraint =>
constraint
Db.notNullConstraintSyntax Maybe
  (Sql92ColumnConstraintDefinitionAttributesSyntax
     SqliteColumnConstraintDefinitionSyntax)
forall a. Maybe a
Nothing)
                                         :: Db.TableColumnHasConstraint Sqlite) ]
                           else []

                     in [ TableHasColumn Sqlite -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate
                            (QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax Sqlite
-> TableHasColumn Sqlite
forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
Db.TableHasColumn QualifiedName
tblName Text
nm BeamMigrateSqlBackendDataTypeSyntax Sqlite
SqliteDataTypeSyntax
dtType ::
                               Db.TableHasColumn Sqlite) ] [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++
                        [SomeDatabasePredicate]
notNullPred
                )
                [(Int, Text, Text, Bool, Maybe Text, Int)]
columns

            pkColumns :: [Text]
pkColumns = ((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Text
forall a b. (a, b) -> a
fst ([(Text, Int)] -> [Text]) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> a -> b
$ ((Text, Int) -> (Text, Int) -> Ordering)
-> [(Text, Int)] -> [(Text, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Text, Int) -> Int) -> (Text, Int) -> (Text, Int) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Text, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Text, Int)] -> [(Text, Int)]) -> [(Text, Int)] -> [(Text, Int)]
forall a b. (a -> b) -> a -> b
$
                        ((Int, Text, Text, Bool, Maybe Text, Int) -> Maybe (Text, Int))
-> [(Int, Text, Text, Bool, Maybe Text, Int)] -> [(Text, Int)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (\(Int
_, Text
nm, Text
_, Bool
_, Maybe Text
_ :: Maybe T.Text, Int
pk) ->
                                      (Text
nm,) (Int -> (Text, Int)) -> Maybe Int -> Maybe (Text, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
pk Int -> Maybe () -> Maybe Int
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
pk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
0 :: Int)))) [(Int, Text, Text, Bool, Maybe Text, Int)]
columns
            pkPred :: [SomeDatabasePredicate]
pkPred = case [Text]
pkColumns of
                       [] -> []
                       [Text]
_  -> [ TableHasPrimaryKey -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> [Text] -> TableHasPrimaryKey
Db.TableHasPrimaryKey QualifiedName
tblName [Text]
pkColumns) ]
        [SomeDatabasePredicate] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( [ TableExistsPredicate -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
Db.SomeDatabasePredicate (QualifiedName -> TableExistsPredicate
Db.TableExistsPredicate QualifiedName
tblName) ]
             [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
pkPred [SomeDatabasePredicate]
-> [SomeDatabasePredicate] -> [SomeDatabasePredicate]
forall a. [a] -> [a] -> [a]
++ [SomeDatabasePredicate]
columnPreds )

    [SomeDatabasePredicate] -> IO [SomeDatabasePredicate]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [SomeDatabasePredicate]
tblPreds

sqliteText :: Db.DataType Sqlite T.Text
sqliteText :: DataType Sqlite Text
sqliteText = BeamSqlBackendCastTargetSyntax Sqlite -> DataType Sqlite Text
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Sqlite
SqliteDataTypeSyntax
sqliteTextType

sqliteBlob :: Db.DataType Sqlite ByteString
sqliteBlob :: DataType Sqlite ByteString
sqliteBlob = BeamSqlBackendCastTargetSyntax Sqlite -> DataType Sqlite ByteString
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Sqlite
SqliteDataTypeSyntax
sqliteBlobType

sqliteBigInt :: Db.DataType Sqlite Int64
sqliteBigInt :: DataType Sqlite Int64
sqliteBigInt = BeamSqlBackendCastTargetSyntax Sqlite -> DataType Sqlite Int64
forall be a. BeamSqlBackendCastTargetSyntax be -> DataType be a
Db.DataType BeamSqlBackendCastTargetSyntax Sqlite
SqliteDataTypeSyntax
sqliteBigIntType