{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}

-- | Definitions of interest to those implement a new beam backend.
--
-- Steps to defining a beam backend:
--
--   1. Ensure the command syntax for your backend satisfies 'Sql92SaneDdlCommandSyntax'.
--   2. Create a value of type 'BeamMigrationBackend'
--   3. For compatibility with @beam-migrate-cli@, export this value in an
--      exposed module with the name 'migrationBackend'.
--
-- This may sound trivial, but it's a bit more involved. In particular, in order
-- to complete step 2, you will have to define several instances for some of
-- your syntax pieces (for example, data types and constraints will need to be
-- 'Hashable'). You will also need to provide a reasonable function to fetch
-- predicates from your database, and a function to convert all these predicates
-- to corresponding predicates in the Haskell syntax. If you have custom data
-- types or predicates, you will need to supply 'BeamDeserializers' to
-- deserialize them from JSON. Finally, if your backend has custom
-- 'DatabasePredicate's you will have to provide appropriate 'ActionProvider's
-- to discover potential actions for your backend. See the documentation for
-- "Database.Beam.Migrate.Actions" for more information.
--
-- Tools may be interested in the 'SomeBeamMigrationBackend' data type which
-- provides a monomorphic type to wrap the polymorphic 'BeamMigrationBackend'
-- type. Currently, @beam-migrate-cli@ uses this type to get the underlying
-- 'BeamMigrationBackend' via the @hint@ package.
--
-- For an example migrate backend, see "Database.Beam.Sqlite.Migrate"
module Database.Beam.Migrate.Backend
  ( BeamMigrationBackend(..)
  , DdlError

  -- * Haskell predicate conversion
  , HaskellPredicateConverter(..)
  , sql92HsPredicateConverters
  , hasColumnConverter
  , trivialHsConverter, hsPredicateConverter

  -- * For tooling authors
  , SomeBeamMigrationBackend(..), SomeCheckedDatabaseSettings(..) )
where

import           Database.Beam
import           Database.Beam.Backend.SQL
import           Database.Beam.Migrate.Actions
import           Database.Beam.Migrate.Checks
import           Database.Beam.Migrate.Serialization
import           Database.Beam.Migrate.SQL
import           Database.Beam.Migrate.Types
  ( SomeDatabasePredicate(..), CheckedDatabaseSettings )

import           Database.Beam.Haskell.Syntax

import           Control.Applicative
import qualified Control.Monad.Fail as Fail

#if ! MIN_VERSION_base(4,11,0)
import           Data.Semigroup
#endif
import           Data.Text (Text)
import           Data.Time

import           Data.Typeable

-- | Type of errors that can be thrown by backends during DDL statement
-- execution. Currently just a synonym for 'String'
type DdlError = String

-- | Backends should create a value of this type and export it in an exposed
-- module under the name 'migrationBackend'. See the module documentation for
-- more details.
data BeamMigrationBackend be m where
  BeamMigrationBackend ::
    ( MonadBeam be m
    , Fail.MonadFail m
    , HasQBuilder be
    , BeamMigrateSqlBackend be
    , HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be)
    , BeamSqlBackendCanSerialize be LocalTime
    , BeamSqlBackendCanSerialize be (Maybe LocalTime)
    , BeamSqlBackendCanSerialize be Text
    , BeamSqlBackendCanSerialize be SqlNull
    , Sql92ReasonableMarshaller be ) =>
    { forall be (m :: * -> *). BeamMigrationBackend be m -> String
backendName :: String
    , forall be (m :: * -> *). BeamMigrationBackend be m -> String
backendConnStringExplanation :: String
    , forall be (m :: * -> *).
BeamMigrationBackend be m -> m [SomeDatabasePredicate]
backendGetDbConstraints :: m [ SomeDatabasePredicate ]
    , forall be (m :: * -> *).
BeamMigrationBackend be m -> BeamDeserializers be
backendPredicateParsers :: BeamDeserializers be
    , forall be (m :: * -> *).
BeamMigrationBackend be m -> BeamSqlBackendSyntax be -> String
backendRenderSyntax :: BeamSqlBackendSyntax be -> String
    , forall be (m :: * -> *). BeamMigrationBackend be m -> String
backendFileExtension :: String
    , forall be (m :: * -> *).
BeamMigrationBackend be m -> HaskellPredicateConverter
backendConvertToHaskell :: HaskellPredicateConverter
    , forall be (m :: * -> *).
BeamMigrationBackend be m -> ActionProvider be
backendActionProvider :: ActionProvider be
    , forall be (m :: * -> *).
BeamMigrationBackend be m
-> forall a. String -> m a -> IO (Either String a)
backendTransact :: forall a. String -> m a -> IO (Either DdlError a)
    } -> BeamMigrationBackend be m

-- | Monomorphic wrapper for use with plugin loaders that cannot handle
-- polymorphism
data SomeBeamMigrationBackend where
  SomeBeamMigrationBackend :: Typeable be
                           => BeamMigrationBackend be m
                           -> SomeBeamMigrationBackend

-- | Monomorphic wrapper to use when interpreting a module which
-- exports a 'CheckedDatabaseSettings'.
data SomeCheckedDatabaseSettings where
  SomeCheckedDatabaseSettings :: Database be db => CheckedDatabaseSettings be db
                              -> SomeCheckedDatabaseSettings

-- | In order to support Haskell schema generation, backends need to provide a
-- way to convert arbitrary 'DatabasePredicate's generated by the backend's
-- 'backendGetDbConstraints' function into appropriate predicates in the Haskell
-- syntax. Not all predicates have any meaning when translated to Haskell, so
-- backends can choose to drop any predicate (simply return 'Nothing').
newtype HaskellPredicateConverter
  = HaskellPredicateConverter (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)

instance Semigroup HaskellPredicateConverter where
  <> :: HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
(<>) = HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
forall a. Monoid a => a -> a -> a
mappend

-- | 'HaskellPredicateConverter's can be combined monoidally.
instance Monoid HaskellPredicateConverter where
  mempty :: HaskellPredicateConverter
mempty = (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
HaskellPredicateConverter ((SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
 -> HaskellPredicateConverter)
-> (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall a b. (a -> b) -> a -> b
$ \SomeDatabasePredicate
_ -> Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing
  mappend :: HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
mappend (HaskellPredicateConverter SomeDatabasePredicate -> Maybe SomeDatabasePredicate
a) (HaskellPredicateConverter SomeDatabasePredicate -> Maybe SomeDatabasePredicate
b) =
    (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
HaskellPredicateConverter ((SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
 -> HaskellPredicateConverter)
-> (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall a b. (a -> b) -> a -> b
$ \SomeDatabasePredicate
r -> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
a SomeDatabasePredicate
r Maybe SomeDatabasePredicate
-> Maybe SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
b SomeDatabasePredicate
r

-- | Converters for the 'TableExistsPredicate', 'TableHasPrimaryKey', and
-- 'TableHasColumn' (when supplied with a function to convert a backend data
-- type to a haskell one).
sql92HsPredicateConverters :: forall fromBe
                             . Typeable fromBe
                            => (BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
                            -> HaskellPredicateConverter
sql92HsPredicateConverters :: forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
sql92HsPredicateConverters BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType
convType =
  forall pred. Typeable pred => HaskellPredicateConverter
trivialHsConverter @TableExistsPredicate HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
forall a. Semigroup a => a -> a -> a
<>
  forall pred. Typeable pred => HaskellPredicateConverter
trivialHsConverter @TableHasPrimaryKey   HaskellPredicateConverter
-> HaskellPredicateConverter -> HaskellPredicateConverter
forall a. Semigroup a => a -> a -> a
<>
  forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
hasColumnConverter @fromBe BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType
convType

-- | Converter for 'TableHasColumn', when given a function to convert backend
-- data type to a haskell one.
hasColumnConverter :: forall fromBe
                    . Typeable fromBe
                   => (BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
                   -> HaskellPredicateConverter
hasColumnConverter :: forall fromBe.
Typeable fromBe =>
(BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType)
-> HaskellPredicateConverter
hasColumnConverter BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType
convType =
  (TableHasColumn fromBe -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall pred.
Typeable pred =>
(pred -> Maybe SomeDatabasePredicate) -> HaskellPredicateConverter
hsPredicateConverter ((TableHasColumn fromBe -> Maybe SomeDatabasePredicate)
 -> HaskellPredicateConverter)
-> (TableHasColumn fromBe -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall a b. (a -> b) -> a -> b
$
  \(TableHasColumn QualifiedName
tbl Text
col BeamMigrateSqlBackendDataTypeSyntax fromBe
ty :: TableHasColumn fromBe) ->
    (TableHasColumn HsMigrateBackend -> SomeDatabasePredicate)
-> Maybe (TableHasColumn HsMigrateBackend)
-> Maybe SomeDatabasePredicate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TableHasColumn HsMigrateBackend -> SomeDatabasePredicate
forall p. DatabasePredicate p => p -> SomeDatabasePredicate
SomeDatabasePredicate (QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax HsMigrateBackend
-> TableHasColumn HsMigrateBackend
forall be.
HasDataTypeCreatedCheck (BeamMigrateSqlBackendDataTypeSyntax be) =>
QualifiedName
-> Text
-> BeamMigrateSqlBackendDataTypeSyntax be
-> TableHasColumn be
TableHasColumn QualifiedName
tbl Text
col (HsDataType -> TableHasColumn HsMigrateBackend)
-> Maybe HsDataType -> Maybe (TableHasColumn HsMigrateBackend)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BeamMigrateSqlBackendDataTypeSyntax fromBe -> Maybe HsDataType
convType BeamMigrateSqlBackendDataTypeSyntax fromBe
ty :: Maybe (TableHasColumn HsMigrateBackend))

-- | Some predicates have no dependence on a backend. For example, 'TableExistsPredicate' has no parameters that
-- depend on the backend. It can be converted straightforwardly:
--
-- @
-- trivialHsConverter @TableExistsPredicate
-- @
trivialHsConverter :: forall pred. Typeable pred => HaskellPredicateConverter
trivialHsConverter :: forall pred. Typeable pred => HaskellPredicateConverter
trivialHsConverter =
  (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
HaskellPredicateConverter ((SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
 -> HaskellPredicateConverter)
-> (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall a b. (a -> b) -> a -> b
$ \orig :: SomeDatabasePredicate
orig@(SomeDatabasePredicate p
p') ->
  case p -> Maybe pred
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
p' of
    Maybe pred
Nothing -> Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing
    Just (pred
_ :: pred) -> SomeDatabasePredicate -> Maybe SomeDatabasePredicate
forall a. a -> Maybe a
Just SomeDatabasePredicate
orig

-- | Utility function for converting a monomorphically typed predicate to a
-- haskell one.
hsPredicateConverter :: Typeable pred => (pred -> Maybe SomeDatabasePredicate) -> HaskellPredicateConverter
hsPredicateConverter :: forall pred.
Typeable pred =>
(pred -> Maybe SomeDatabasePredicate) -> HaskellPredicateConverter
hsPredicateConverter pred -> Maybe SomeDatabasePredicate
f =
  (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
HaskellPredicateConverter ((SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
 -> HaskellPredicateConverter)
-> (SomeDatabasePredicate -> Maybe SomeDatabasePredicate)
-> HaskellPredicateConverter
forall a b. (a -> b) -> a -> b
$ \(SomeDatabasePredicate p
p') ->
  case p -> Maybe pred
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast p
p' of
    Maybe pred
Nothing -> Maybe SomeDatabasePredicate
forall a. Maybe a
Nothing
    Just pred
p'' -> pred -> Maybe SomeDatabasePredicate
f pred
p''