content: -- Tests copied from `polysemy-plugin` (https://github.com/polysemy-research/polysemy/tree/master/polysemy-plugin/test)
  -- (c) 2019 Sandy Maguire, licensed under BSD-3-Clause
  {-# LANGUAGE AllowAmbiguousTypes #-}
  {-# LANGUAGE OverloadedStrings   #-}
  {-# OPTIONS_GHC -Wno-unused-foralls -fplugin=Cleff.Plugin #-}
  module CleffSpec where
  
  import           Cleff
  import           Cleff.Error
  import           Cleff.State
  import           Data.String   (IsString)
  import           Unsafe.Coerce (unsafeCoerce)
  
  class MPTC a b where
    mptc :: a -> b
  
  instance MPTC Bool Int where
    mptc _ = 1000
  
  uniquelyInt :: '[State Int, State String] :>> r => Eff r ()
  uniquelyInt = put 10
  
  uniquelyA :: (Num a, '[State a, State b] :>> r) => Eff r ()
  uniquelyA = put 10
  
  uniquelyString :: '[State Int, State String] :>> r => Eff r ()
  uniquelyString = put mempty
  
  uniquelyB :: (MPTC Bool b, '[State String, State b] :>> r) => Eff r ()
  uniquelyB = put $ mptc False
  
  uniquelyState' :: '[Error (), State ()] :>> r => Eff r ()
  uniquelyState' = pure ()
  
  idState :: State s :> r => Eff r ()
  idState = do
    s <- get
    put s
  
  intState :: State Int :> r => Eff r ()
  intState = put 10
  
  numState :: Num a => State a :> r => Eff r ()
  numState = put 10
  
  strState :: State String :> r => Eff r ()
  strState = put "Hello"
  
  oStrState :: IsString a => State a :> r => Eff r ()
  oStrState = put "hello"
  
  err :: Error e :> r => Eff r Bool
  err =
    catchError
      (throwError (error ""))
      (\_ -> pure True)
  
  errState :: Num s => '[Error e, State s] :>> r => Eff r Bool
  errState = do
    numState
    err
  
  newtype MyString = MyString String
    deriving newtype (IsString, Eq, Show)
  
  data Janky = forall s. Janky (forall _i. Eff '[State s] ())
  
  jankyState :: Janky
  jankyState = Janky $ put True -- The plugin disambiguates effects for concrete rows too
  
  unsafeUnjank :: Janky -> Eff '[State Bool] ()
  unsafeUnjank (Janky m) = unsafeCoerce m
  
  data MoreJanky = forall y. MoreJanky (MPTC Bool y => Eff '[State (Bool, y), State (Char, y)] ())
  
  mptcGet :: MPTC x Bool => x
  mptcGet = undefined
  
  moreJankyState :: MoreJanky
  moreJankyState = MoreJanky $ put (mptcGet, True)
  
  data TaggedState k s m a where
    TaggedGet :: forall k s m. TaggedState k s m s
    TaggedPut :: forall k s m. s -> TaggedState k s m ()
  
  makeEffect ''TaggedState -- The plugin also disambiguates TH functions generated by 'makeEffect'
  
  runTaggedState :: forall k s r a
                  . s
                 -> Eff (TaggedState k s : r) a
                 -> Eff r (a, s)
  runTaggedState s =
      (runState s .)
    $ reinterpret
    $ \case
      TaggedGet    -> get
      TaggedPut s' -> put s'
  
  test :: '[
            TaggedState Char Int
          , TaggedState Bool Int
          ] :>> r
       => Eff r ()
  test = do
    taggedPut @Bool 10
    taggedPut @Char (-10)
  
  newtype Select a = Select a
  
  data DBAction whichDb m a where
    DoSelect :: Select a -> DBAction whichDb m (Maybe a)
  
  makeEffect ''DBAction
  
  runDBAction :: Eff (DBAction which ': r) a -> Eff r a
  runDBAction = interpret $ \case
    DoSelect (Select a) -> pure $ Just a
  