{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}

module Opaleye.Internal.Inferrable where

import qualified Opaleye.Column as C
import           Opaleye.Internal.RunQuery (FromField, FromFields)
import qualified Opaleye.Internal.RunQuery as RQ
import qualified Opaleye.SqlTypes as T
import           Opaleye.Internal.Constant (ToFields)

import qualified Data.ByteString as SBS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.CaseInsensitive as CI
import qualified Data.Profunctor as P
import qualified Data.Profunctor.Product as PP
import qualified Data.Profunctor.Product.Default as D
import qualified Data.Scientific                 as Sci
import qualified Data.Text.Lazy as LT
import qualified Data.Text as ST
import qualified Data.Time as Time
import           Data.Typeable (Typeable)
import           Data.UUID (UUID)
import qualified Database.PostgreSQL.Simple.Range as R
import           GHC.Int (Int32, Int64)

-- | Despite its name, 'Inferrable' doesn't provide any inferability
-- improvements itself, it's just a conveniently-named newtype wrapper
-- to hang instances with better inferrability off of.
newtype Inferrable p a b = Inferrable { Inferrable p a b -> p a b
runInferrable :: p a b }

-- FromFields

-- OVERLAPPABLE is pretty grim, but it will go away when we switch to Field
instance {-# OVERLAPPABLE #-}
  D.Default (Inferrable FromField) a b
  => D.Default (Inferrable FromFields) (C.Column a) b where
  def :: Inferrable FromFields (Column a) b
def = FromFields (Column a) b -> Inferrable FromFields (Column a) b
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (FromField a b -> FromFields (Column a) b
forall a b. FromField a b -> FromFields (Column a) b
RQ.queryRunner (Inferrable FromField a b -> FromField a b
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable FromField a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))

instance
     (D.Default (Inferrable FromField) a b, Maybe b ~ maybe_b)
  => D.Default (Inferrable FromFields) (C.Column (C.Nullable a)) maybe_b where
  def :: Inferrable FromFields (Column (Nullable a)) maybe_b
def = FromFields (Column (Nullable a)) (Maybe b)
-> Inferrable FromFields (Column (Nullable a)) (Maybe b)
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (FromField (Nullable a) (Maybe b)
-> FromFields (Column (Nullable a)) (Maybe b)
forall a b. FromField a b -> FromFields (Column a) b
RQ.queryRunner (FromField a b -> FromField (Nullable a) (Maybe b)
forall a b. FromField a b -> FromField (Nullable a) (Maybe b)
RQ.queryRunnerColumnNullable (Inferrable FromField a b -> FromField a b
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable FromField a b
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def)))

-- FromField

instance int ~ Int => D.Default (Inferrable FromField) T.SqlInt4 int where
  def :: Inferrable FromField SqlInt4 int
def = FromField SqlInt4 int -> Inferrable FromField SqlInt4 int
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlInt4 int
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance int64 ~ Int64 => D.Default (Inferrable FromField) T.SqlInt8 int64 where
  def :: Inferrable FromField SqlInt8 int64
def = FromField SqlInt8 int64 -> Inferrable FromField SqlInt8 int64
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlInt8 int64
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance text ~ ST.Text => D.Default (Inferrable FromField) T.SqlText text where
  def :: Inferrable FromField SqlText text
def = FromField SqlText text -> Inferrable FromField SqlText text
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlText text
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance (Typeable h, D.Default (Inferrable FromField) f h, hs ~ [h])
  => D.Default (Inferrable FromField) (T.SqlArray f) hs where
  def :: Inferrable FromField (SqlArray f) hs
def = FromField (SqlArray f) [h] -> Inferrable FromField (SqlArray f) [h]
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (FromField f h -> FromField (SqlArray f) [h]
forall h f.
Typeable h =>
FromField f h -> FromField (SqlArray f) [h]
RQ.fromFieldArray (Inferrable FromField f h -> FromField f h
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable FromField f h
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def))

instance double ~ Double => D.Default (Inferrable FromField) T.SqlFloat8 double where
  def :: Inferrable FromField SqlFloat8 double
def = FromField SqlFloat8 double -> Inferrable FromField SqlFloat8 double
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlFloat8 double
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance scientific ~ Sci.Scientific
  => D.Default (Inferrable FromField) T.SqlNumeric scientific where
  def :: Inferrable FromField SqlNumeric scientific
def = FromField SqlNumeric scientific
-> Inferrable FromField SqlNumeric scientific
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlNumeric scientific
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance bool ~ Bool => D.Default (Inferrable FromField) T.SqlBool bool where
  def :: Inferrable FromField SqlBool bool
def = FromField SqlBool bool -> Inferrable FromField SqlBool bool
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlBool bool
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance uuid ~ UUID => D.Default (Inferrable FromField) T.SqlUuid uuid where
  def :: Inferrable FromField SqlUuid uuid
def = FromField SqlUuid uuid -> Inferrable FromField SqlUuid uuid
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlUuid uuid
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance bytestring ~ SBS.ByteString
  => D.Default (Inferrable FromField) T.SqlBytea bytestring where
  def :: Inferrable FromField SqlBytea bytestring
def = FromField SqlBytea bytestring
-> Inferrable FromField SqlBytea bytestring
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlBytea bytestring
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance day ~ Time.Day
  => D.Default (Inferrable FromField) T.SqlDate day where
  def :: Inferrable FromField SqlDate day
def = FromField SqlDate day -> Inferrable FromField SqlDate day
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlDate day
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

-- I'm not certain what we should map timestamptz to.  The
-- postgresql-simple types it maps to are ZonedTime and UTCTime, but
-- maybe it's more accurate to map it to a *pair* of LocalTime and a
-- time zone.

--instance utctime ~ Time.UTCTime
--  => D.Default (Inferrable FromField) T.SqlTimestamptz utctime where
--  def = Inferrable D.def

instance localtime ~ Time.LocalTime
  => D.Default (Inferrable FromField) T.SqlTimestamp localtime where
  def :: Inferrable FromField SqlTimestamp localtime
def = FromField SqlTimestamp localtime
-> Inferrable FromField SqlTimestamp localtime
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlTimestamp localtime
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance timeofday ~ Time.TimeOfDay
  => D.Default (Inferrable FromField) T.SqlTime timeofday where
  def :: Inferrable FromField SqlTime timeofday
def = FromField SqlTime timeofday
-> Inferrable FromField SqlTime timeofday
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlTime timeofday
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance cttext ~ CI.CI ST.Text
  => D.Default (Inferrable FromField) T.SqlCitext cttext where
  def :: Inferrable FromField SqlCitext cttext
def = FromField SqlCitext cttext -> Inferrable FromField SqlCitext cttext
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable FromField SqlCitext cttext
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

-- It's not clear what to map JSON types to

{-
instance QueryRunnerColumnDefault T.PGJson String where
  defaultFromField = fieldParserQueryRunnerColumn jsonFieldParser

instance QueryRunnerColumnDefault T.PGJson Ae.Value where
  defaultFromField = fromPGSFromField

instance QueryRunnerColumnDefault T.PGJsonb String where
  defaultFromField = fieldParserQueryRunnerColumn jsonbFieldParser

instance QueryRunnerColumnDefault T.PGJsonb Ae.Value where
  defaultFromField = fromPGSFromField

instance QueryRunnerColumnDefault T.PGTimestamptz Time.UTCTime where
  defaultFromField = fromPGSFromField

instance QueryRunnerColumnDefault T.PGTimestamptz Time.ZonedTime where
  defaultFromField = fromPGSFromField
-}

-- ToFields

{- The instance for arrays would clash with String.  String is going to
   be use far more, so to get arrays you'll have to explicitly use
   `sqlArray`.

instance (D.Default (Inferrable ToFields) a (C.Column b),
          T.IsSqlType b,
          C.Column (T.SqlArray b) ~ cSqlArrayb)
         => D.Default (Inferrable ToFields) [a] cSqlArrayb where
  def = Inferrable (toToFields (T.sqlArray (toFieldsExplicit
                                               (runInferrable D.def))))
-}

instance C.Column a ~ columnA
  => D.Default (Inferrable ToFields) (C.Column a) columnA where
  def :: Inferrable ToFields (Column a) columnA
def = ToFields (Column a) columnA
-> Inferrable ToFields (Column a) columnA
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (Column a) columnA
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlText ~ cSqlText
  => D.Default (Inferrable ToFields) String cSqlText where
  def :: Inferrable ToFields String cSqlText
def = ToFields String cSqlText -> Inferrable ToFields String cSqlText
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields String cSqlText
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlBytea ~ cSqlBytea
  => D.Default (Inferrable ToFields) LBS.ByteString cSqlBytea where
  def :: Inferrable ToFields ByteString cSqlBytea
def = ToFields ByteString cSqlBytea
-> Inferrable ToFields ByteString cSqlBytea
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields ByteString cSqlBytea
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlBytea ~ cSqlBytea
  => D.Default (Inferrable ToFields) SBS.ByteString cSqlBytea where
  def :: Inferrable ToFields ByteString cSqlBytea
def = ToFields ByteString cSqlBytea
-> Inferrable ToFields ByteString cSqlBytea
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields ByteString cSqlBytea
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlText ~ cSqlText
  => D.Default (Inferrable ToFields) ST.Text cSqlText where
  def :: Inferrable ToFields Text cSqlText
def = ToFields Text cSqlText -> Inferrable ToFields Text cSqlText
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Text cSqlText
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlText ~ cSqlText
  => D.Default (Inferrable ToFields) LT.Text cSqlText where
  def :: Inferrable ToFields Text cSqlText
def = ToFields Text cSqlText -> Inferrable ToFields Text cSqlText
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Text cSqlText
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlNumeric ~ cSqlNumeric
  => D.Default (Inferrable ToFields) Sci.Scientific cSqlNumeric where
  def :: Inferrable ToFields Scientific cSqlNumeric
def = ToFields Scientific cSqlNumeric
-> Inferrable ToFields Scientific cSqlNumeric
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Scientific cSqlNumeric
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlInt4 ~ cSqlInt4
  => D.Default (Inferrable ToFields) Int cSqlInt4 where
  def :: Inferrable ToFields Int cSqlInt4
def = ToFields Int cSqlInt4 -> Inferrable ToFields Int cSqlInt4
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Int cSqlInt4
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlInt4 ~ cSqlInt4
  => D.Default (Inferrable ToFields) Int32 cSqlInt4 where
  def :: Inferrable ToFields Int32 cSqlInt4
def = ToFields Int32 cSqlInt4 -> Inferrable ToFields Int32 cSqlInt4
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Int32 cSqlInt4
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlInt8 ~ cSqlInt8
  => D.Default (Inferrable ToFields) Int64 cSqlInt8 where
  def :: Inferrable ToFields Int64 cSqlInt8
def = ToFields Int64 cSqlInt8 -> Inferrable ToFields Int64 cSqlInt8
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Int64 cSqlInt8
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlFloat8 ~ cSqlFloat8
  => D.Default (Inferrable ToFields) Double cSqlFloat8 where
  def :: Inferrable ToFields Double cSqlFloat8
def = ToFields Double cSqlFloat8 -> Inferrable ToFields Double cSqlFloat8
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Double cSqlFloat8
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlBool ~ cSqlBool
  => D.Default (Inferrable ToFields) Bool cSqlBool where
  def :: Inferrable ToFields Bool cSqlBool
def = ToFields Bool cSqlBool -> Inferrable ToFields Bool cSqlBool
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Bool cSqlBool
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlUuid ~ cSqlUuid
  => D.Default (Inferrable ToFields) UUID cSqlUuid where
  def :: Inferrable ToFields UUID cSqlUuid
def = ToFields UUID cSqlUuid -> Inferrable ToFields UUID cSqlUuid
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields UUID cSqlUuid
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlDate ~ cSqlDate
  => D.Default (Inferrable ToFields) Time.Day cSqlDate where
  def :: Inferrable ToFields Day cSqlDate
def = ToFields Day cSqlDate -> Inferrable ToFields Day cSqlDate
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields Day cSqlDate
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlTimestamptz ~ cSqlTimestamptz
  => D.Default (Inferrable ToFields) Time.UTCTime cSqlTimestamptz where
  def :: Inferrable ToFields UTCTime cSqlTimestamptz
def = ToFields UTCTime cSqlTimestamptz
-> Inferrable ToFields UTCTime cSqlTimestamptz
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields UTCTime cSqlTimestamptz
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlTimestamptz ~ cSqlTimestamptz
  => D.Default (Inferrable ToFields) Time.ZonedTime cSqlTimestamptz where
  def :: Inferrable ToFields ZonedTime cSqlTimestamptz
def = ToFields ZonedTime cSqlTimestamptz
-> Inferrable ToFields ZonedTime cSqlTimestamptz
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields ZonedTime cSqlTimestamptz
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlTime ~ cSqlTime
  => D.Default (Inferrable ToFields) Time.TimeOfDay cSqlTime where
  def :: Inferrable ToFields TimeOfDay cSqlTime
def = ToFields TimeOfDay cSqlTime
-> Inferrable ToFields TimeOfDay cSqlTime
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields TimeOfDay cSqlTime
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlCitext ~ cSqlCitext
  => D.Default (Inferrable ToFields) (CI.CI ST.Text) cSqlCitext where
  def :: Inferrable ToFields (CI Text) cSqlCitext
def = ToFields (CI Text) cSqlCitext
-> Inferrable ToFields (CI Text) cSqlCitext
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (CI Text) cSqlCitext
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column T.SqlCitext ~ cSqlCitext
  => D.Default (Inferrable ToFields) (CI.CI LT.Text) cSqlCitext where
  def :: Inferrable ToFields (CI Text) cSqlCitext
def = ToFields (CI Text) cSqlCitext
-> Inferrable ToFields (CI Text) cSqlCitext
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (CI Text) cSqlCitext
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlInt4) ~ cRangeInt4
  => D.Default (Inferrable ToFields) (R.PGRange Int) cRangeInt4 where
  def :: Inferrable ToFields (PGRange Int) cRangeInt4
def = ToFields (PGRange Int) cRangeInt4
-> Inferrable ToFields (PGRange Int) cRangeInt4
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange Int) cRangeInt4
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlInt8) ~ cRangeInt8
  => D.Default (Inferrable ToFields) (R.PGRange Int64) cRangeInt8 where
  def :: Inferrable ToFields (PGRange Int64) cRangeInt8
def = ToFields (PGRange Int64) cRangeInt8
-> Inferrable ToFields (PGRange Int64) cRangeInt8
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange Int64) cRangeInt8
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlNumeric) ~ cRangeScientific
  => D.Default (Inferrable ToFields) (R.PGRange Sci.Scientific) cRangeScientific where
  def :: Inferrable ToFields (PGRange Scientific) cRangeScientific
def = ToFields (PGRange Scientific) cRangeScientific
-> Inferrable ToFields (PGRange Scientific) cRangeScientific
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange Scientific) cRangeScientific
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlTimestamp) ~ cRangeTimestamp
  => D.Default (Inferrable ToFields) (R.PGRange Time.LocalTime) cRangeTimestamp where
  def :: Inferrable ToFields (PGRange LocalTime) cRangeTimestamp
def = ToFields (PGRange LocalTime) cRangeTimestamp
-> Inferrable ToFields (PGRange LocalTime) cRangeTimestamp
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange LocalTime) cRangeTimestamp
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlTimestamptz) ~ cRangeTimestamptz
  => D.Default (Inferrable ToFields) (R.PGRange Time.UTCTime) cRangeTimestamptz where
  def :: Inferrable ToFields (PGRange UTCTime) cRangeTimestamptz
def = ToFields (PGRange UTCTime) cRangeTimestamptz
-> Inferrable ToFields (PGRange UTCTime) cRangeTimestamptz
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange UTCTime) cRangeTimestamptz
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

instance C.Column (T.SqlRange T.SqlDate) ~ cRangeDate
  => D.Default (Inferrable ToFields) (R.PGRange Time.Day) cRangeDate where
  def :: Inferrable ToFields (PGRange Day) cRangeDate
def = ToFields (PGRange Day) cRangeDate
-> Inferrable ToFields (PGRange Day) cRangeDate
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable ToFields (PGRange Day) cRangeDate
forall (p :: * -> * -> *) a b. Default p a b => p a b
D.def

{-  It's not clear if Aeson Value should map to JSON or JSONB.

instance D.Default ToFields Ae.Value (Column T.SqlJson) where
  def = Constant T.sqlValueJSON

instance D.Default ToFields Ae.Value (Column T.SqlJsonb) where
  def = Constant T.sqlValueJSONB

-}

-- Boilerplate instances

instance Functor (p a) => Functor (Inferrable p a) where
  fmap :: (a -> b) -> Inferrable p a a -> Inferrable p a b
fmap a -> b
f = p a b -> Inferrable p a b
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (p a b -> Inferrable p a b)
-> (Inferrable p a a -> p a b)
-> Inferrable p a a
-> Inferrable p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (p a a -> p a b)
-> (Inferrable p a a -> p a a) -> Inferrable p a a -> p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inferrable p a a -> p a a
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable

instance Applicative (p a) => Applicative (Inferrable p a) where
  pure :: a -> Inferrable p a a
pure = p a a -> Inferrable p a a
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (p a a -> Inferrable p a a)
-> (a -> p a a) -> a -> Inferrable p a a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> p a a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Inferrable p a (a -> b)
f <*> :: Inferrable p a (a -> b) -> Inferrable p a a -> Inferrable p a b
<*> Inferrable p a a
x = p a b -> Inferrable p a b
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (Inferrable p a (a -> b) -> p a (a -> b)
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a (a -> b)
f p a (a -> b) -> p a a -> p a b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Inferrable p a a -> p a a
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a a
x)

instance P.Profunctor p => P.Profunctor (Inferrable p) where
  dimap :: (a -> b) -> (c -> d) -> Inferrable p b c -> Inferrable p a d
dimap a -> b
f c -> d
g = p a d -> Inferrable p a d
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (p a d -> Inferrable p a d)
-> (Inferrable p b c -> p a d)
-> Inferrable p b c
-> Inferrable p a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> (c -> d) -> p b c -> p a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
f c -> d
g (p b c -> p a d)
-> (Inferrable p b c -> p b c) -> Inferrable p b c -> p a d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inferrable p b c -> p b c
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable

instance PP.ProductProfunctor p => PP.ProductProfunctor (Inferrable p) where
  purePP :: b -> Inferrable p a b
purePP = p a b -> Inferrable p a b
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (p a b -> Inferrable p a b)
-> (b -> p a b) -> b -> Inferrable p a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> p a b
forall (p :: * -> * -> *) b a. ProductProfunctor p => b -> p a b
PP.purePP
  Inferrable p a (b -> c)
f **** :: Inferrable p a (b -> c) -> Inferrable p a b -> Inferrable p a c
**** Inferrable p a b
g = p a c -> Inferrable p a c
forall (p :: * -> * -> *) a b. p a b -> Inferrable p a b
Inferrable (Inferrable p a (b -> c) -> p a (b -> c)
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a (b -> c)
f p a (b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) a b c.
ProductProfunctor p =>
p a (b -> c) -> p a b -> p a c
PP.**** Inferrable p a b -> p a b
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
runInferrable Inferrable p a b
g)