{-# LANGUAGE CPP                 #-}
{-# LANGUAGE DeriveDataTypeable  #-}
module Data.Constraint.Deriving.OverlapMode
  ( OverlapMode (..)
  , toOverlapFlag, instanceOverlapMode
  ) where

import           Data.Data           (Data)
import           Data.Semigroup      as Sem (Semigroup (..))
import           Data.Monoid         as Mon (Monoid (..))

#if __GLASGOW_HASKELL__ >= 900
import qualified GHC.Types.Basic as BasicTypes
import qualified GHC.Core.InstEnv as InstEnv
#else
import qualified BasicTypes
import qualified InstEnv
#endif

-- | Define the behavior for the instance selection.
--   Mirrors `BasicTypes.OverlapMode`, but does not have a `SourceText` field.
data OverlapMode
  = NoOverlap
    -- ^ This instance must not overlap another `NoOverlap` instance.
    --   However, it may be overlapped by `Overlapping` instances,
    --   and it may overlap `Overlappable` instances.
  | Overlappable
    -- ^ Silently ignore this instance if you find a
    --   more specific one that matches the constraint
    --   you are trying to resolve
  | Overlapping
    -- ^ Silently ignore any more general instances that may be
    --   used to solve the constraint.
  | Overlaps
    -- ^ Equivalent to having both `Overlapping` and `Overlappable` flags.
  | Incoherent
    -- ^ Behave like Overlappable and Overlapping, and in addition pick
    --   an an arbitrary one if there are multiple matching candidates, and
    --   don't worry about later instantiation
  deriving (OverlapMode -> OverlapMode -> Bool
(OverlapMode -> OverlapMode -> Bool)
-> (OverlapMode -> OverlapMode -> Bool) -> Eq OverlapMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OverlapMode -> OverlapMode -> Bool
$c/= :: OverlapMode -> OverlapMode -> Bool
== :: OverlapMode -> OverlapMode -> Bool
$c== :: OverlapMode -> OverlapMode -> Bool
Eq, Int -> OverlapMode -> ShowS
[OverlapMode] -> ShowS
OverlapMode -> String
(Int -> OverlapMode -> ShowS)
-> (OverlapMode -> String)
-> ([OverlapMode] -> ShowS)
-> Show OverlapMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OverlapMode] -> ShowS
$cshowList :: [OverlapMode] -> ShowS
show :: OverlapMode -> String
$cshow :: OverlapMode -> String
showsPrec :: Int -> OverlapMode -> ShowS
$cshowsPrec :: Int -> OverlapMode -> ShowS
Show, ReadPrec [OverlapMode]
ReadPrec OverlapMode
Int -> ReadS OverlapMode
ReadS [OverlapMode]
(Int -> ReadS OverlapMode)
-> ReadS [OverlapMode]
-> ReadPrec OverlapMode
-> ReadPrec [OverlapMode]
-> Read OverlapMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OverlapMode]
$creadListPrec :: ReadPrec [OverlapMode]
readPrec :: ReadPrec OverlapMode
$creadPrec :: ReadPrec OverlapMode
readList :: ReadS [OverlapMode]
$creadList :: ReadS [OverlapMode]
readsPrec :: Int -> ReadS OverlapMode
$creadsPrec :: Int -> ReadS OverlapMode
Read, Typeable OverlapMode
DataType
Constr
Typeable OverlapMode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> OverlapMode -> c OverlapMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c OverlapMode)
-> (OverlapMode -> Constr)
-> (OverlapMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c OverlapMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c OverlapMode))
-> ((forall b. Data b => b -> b) -> OverlapMode -> OverlapMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> OverlapMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> OverlapMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> OverlapMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> OverlapMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode)
-> Data OverlapMode
OverlapMode -> DataType
OverlapMode -> Constr
(forall b. Data b => b -> b) -> OverlapMode -> OverlapMode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapMode -> c OverlapMode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapMode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> OverlapMode -> u
forall u. (forall d. Data d => d -> u) -> OverlapMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapMode -> c OverlapMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverlapMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapMode)
$cIncoherent :: Constr
$cOverlaps :: Constr
$cOverlapping :: Constr
$cOverlappable :: Constr
$cNoOverlap :: Constr
$tOverlapMode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
gmapMp :: (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
gmapM :: (forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> OverlapMode -> m OverlapMode
gmapQi :: Int -> (forall d. Data d => d -> u) -> OverlapMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> OverlapMode -> u
gmapQ :: (forall d. Data d => d -> u) -> OverlapMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> OverlapMode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> OverlapMode -> r
gmapT :: (forall b. Data b => b -> b) -> OverlapMode -> OverlapMode
$cgmapT :: (forall b. Data b => b -> b) -> OverlapMode -> OverlapMode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c OverlapMode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c OverlapMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c OverlapMode)
dataTypeOf :: OverlapMode -> DataType
$cdataTypeOf :: OverlapMode -> DataType
toConstr :: OverlapMode -> Constr
$ctoConstr :: OverlapMode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c OverlapMode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapMode -> c OverlapMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> OverlapMode -> c OverlapMode
$cp1Data :: Typeable OverlapMode
Data)

instance Sem.Semigroup OverlapMode where
    OverlapMode
NoOverlap <> :: OverlapMode -> OverlapMode -> OverlapMode
<> OverlapMode
m = OverlapMode
m
    OverlapMode
m <> OverlapMode
NoOverlap = OverlapMode
m
    OverlapMode
Incoherent <> OverlapMode
_ = OverlapMode
Incoherent
    OverlapMode
_ <> OverlapMode
Incoherent = OverlapMode
Incoherent
    OverlapMode
Overlaps <> OverlapMode
_   = OverlapMode
Overlaps
    OverlapMode
_ <> OverlapMode
Overlaps   = OverlapMode
Overlaps
    OverlapMode
Overlappable <> OverlapMode
Overlappable = OverlapMode
Overlappable
    OverlapMode
Overlapping  <> OverlapMode
Overlapping  = OverlapMode
Overlapping
    OverlapMode
Overlappable <> OverlapMode
Overlapping  = OverlapMode
Overlaps
    OverlapMode
Overlapping  <> OverlapMode
Overlappable = OverlapMode
Overlaps

instance Mon.Monoid OverlapMode where
    mempty :: OverlapMode
mempty = OverlapMode
NoOverlap
#if !(MIN_VERSION_base(4,11,0))
    mappend = (<>)
#endif


toOverlapFlag :: OverlapMode -> BasicTypes.OverlapFlag
toOverlapFlag :: OverlapMode -> OverlapFlag
toOverlapFlag OverlapMode
m = OverlapMode -> Bool -> OverlapFlag
BasicTypes.OverlapFlag (OverlapMode -> OverlapMode
getOMode OverlapMode
m) Bool
False
  where
    getOMode :: OverlapMode -> OverlapMode
getOMode OverlapMode
NoOverlap    = SourceText -> OverlapMode
BasicTypes.NoOverlap SourceText
noSourceText
    getOMode OverlapMode
Overlapping  = SourceText -> OverlapMode
BasicTypes.Overlapping SourceText
noSourceText
    getOMode OverlapMode
Overlappable = SourceText -> OverlapMode
BasicTypes.Overlappable SourceText
noSourceText
    getOMode OverlapMode
Overlaps     = SourceText -> OverlapMode
BasicTypes.Overlaps SourceText
noSourceText
    getOMode OverlapMode
Incoherent   = SourceText -> OverlapMode
BasicTypes.Incoherent SourceText
noSourceText

#if __GLASGOW_HASKELL__ >= 802
    noSourceText :: SourceText
noSourceText = SourceText
BasicTypes.NoSourceText
#else
    noSourceText = "[plugin-generated code]"
#endif

instanceOverlapMode :: InstEnv.ClsInst -> OverlapMode
instanceOverlapMode :: ClsInst -> OverlapMode
instanceOverlapMode ClsInst
i = case OverlapFlag -> OverlapMode
BasicTypes.overlapMode (ClsInst -> OverlapFlag
InstEnv.is_flag ClsInst
i) of
    BasicTypes.NoOverlap {}    -> OverlapMode
NoOverlap
    BasicTypes.Overlapping {}  -> OverlapMode
Overlapping
    BasicTypes.Overlappable {} -> OverlapMode
Overlappable
    BasicTypes.Overlaps {}     -> OverlapMode
Overlaps
    BasicTypes.Incoherent {}   -> OverlapMode
Incoherent