{-# LANGUAGE CPP #-}

-- __NB__: base-4.17 moves `IsList` to its own module, which avoids the unsafety
--         of importing "GHC.Exts". With prior versions of base, we at least
--         mark the module @Trustworthy@.
#if MIN_VERSION_base(4, 17, 0)
{-# LANGUAGE Safe #-}
#else
{-# LANGUAGE Trustworthy #-}
#endif
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Type class instances that use direct recursion in a potentially partial
--   way. This is separated from the rest of `Yaya.Unsafe.Fold` because you can
--   neither control nor qualify the import of instances. Therefore this module
--   is /extra/ dangerous, as having these instances available applies to the
--   entire module they’re imported into.
--
--   This contains instances that you might /expect/ to see, but which aren’t
--   actually total. For example, folding a lazy list @[a]@ is /not/ guaranteed
--   to terminate.
module Yaya.Unsafe.Fold.Instances
  ( seqFreeT,
  )
where

import safe "base" Control.Category (Category ((.)))
import safe "base" Data.Eq (Eq ((==)))
import safe "base" Data.Foldable (Foldable)
import safe "base" Data.Function (flip)
import safe "base" Data.Functor (Functor, (<$>))
import safe "base" Data.Functor.Classes (Eq1, Show1)
import safe "base" Data.List.NonEmpty (NonEmpty)

-- See comment on @{-# LANGUAGE Safe #-}@ above.
#if MIN_VERSION_base(4, 17, 0)
import "base" GHC.IsList (IsList (Item, fromList, fromListN, toList))
#else
import "base" GHC.Exts (IsList (Item, fromList, fromListN, toList))
#endif
import safe "base" Text.Show (Show (showsPrec))
import safe "comonad" Control.Comonad.Env (EnvT)
import safe "free" Control.Comonad.Cofree (Cofree)
import safe "free" Control.Monad.Trans.Free (Free, FreeF (Free, Pure), free)
import safe "yaya" Yaya.Fold
  ( Corecursive (ana),
    DistributiveLaw,
    Mu,
    Nu,
    Projectable (project),
    Recursive (cata),
    Steppable (embed),
    recursiveEq,
    recursiveShowsPrec,
  )
import safe "yaya" Yaya.Fold.Native (Cofix, Fix)
import safe "yaya" Yaya.Pattern (AndMaybe, XNor)
import safe "this" Yaya.Unsafe.Applied (unsafeFromList)
import safe qualified "this" Yaya.Unsafe.Fold as Unsafe

instance (Functor f) => Corecursive (->) (Fix f) f where
  ana :: forall a. Coalgebra (->) f a -> a -> Fix f
ana = Algebra (->) f (Fix f) -> Coalgebra (->) f a -> a -> Fix f
forall (f :: * -> *) b a.
Functor f =>
Algebra (->) f b -> Coalgebra (->) f a -> a -> b
Unsafe.hylo Algebra (->) f (Fix f)
forall {k} (c :: k -> k -> *) (t :: k) (f :: k -> k).
Steppable c t f =>
Algebra c f t
embed

instance (Functor f) => Recursive (->) (Cofix f) f where
  cata :: forall a. Algebra (->) f a -> Cofix f -> a
cata = (Algebra (->) f a -> Coalgebra (->) f (Cofix f) -> Cofix f -> a)
-> Coalgebra (->) f (Cofix f) -> Algebra (->) f a -> Cofix f -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Algebra (->) f a -> Coalgebra (->) f (Cofix f) -> Cofix f -> a
forall (f :: * -> *) b a.
Functor f =>
Algebra (->) f b -> Coalgebra (->) f a -> a -> b
Unsafe.hylo Coalgebra (->) f (Cofix f)
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k -> k1).
Projectable c t f =>
Coalgebra c f t
project

instance (Functor f, Foldable f, Eq1 f) => Eq (Cofix f) where
  == :: Cofix f -> Cofix f -> Bool
(==) = Cofix f -> Cofix f -> Bool
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
 Eq1 f) =>
t -> u -> Bool
recursiveEq

instance (Functor f, Show1 f) => Show (Cofix f) where
  showsPrec :: Int -> Cofix f -> ShowS
showsPrec = Int -> Cofix f -> ShowS
forall t (f :: * -> *).
(Recursive (->) t f, Show1 f) =>
Int -> t -> ShowS
recursiveShowsPrec

instance (Functor f) => Corecursive (->) (Mu f) f where
  ana :: forall a. Coalgebra (->) f a -> a -> Mu f
ana = Coalgebra (->) f a -> a -> Mu f
forall t (f :: * -> *) a.
(Steppable (->) t f, Functor f) =>
Coalgebra (->) f a -> a -> t
Unsafe.unsafeAna

instance (Functor f) => Recursive (->) (Nu f) f where
  cata :: forall a. Algebra (->) f a -> Nu f -> a
cata = Algebra (->) f a -> Nu f -> a
forall t (f :: * -> *) a.
(Projectable (->) t f, Functor f) =>
Algebra (->) f a -> t -> a
Unsafe.unsafeCata

instance (Functor f, Foldable f, Eq1 f) => Eq (Nu f) where
  == :: Nu f -> Nu f -> Bool
(==) = Nu f -> Nu f -> Bool
forall t (f :: * -> *) u.
(Recursive (->) t f, Steppable (->) u f, Functor f, Foldable f,
 Eq1 f) =>
t -> u -> Bool
recursiveEq

instance (Functor f, Show1 f) => Show (Nu f) where
  showsPrec :: Int -> Nu f -> ShowS
showsPrec = Int -> Nu f -> ShowS
forall t (f :: * -> *).
(Recursive (->) t f, Show1 f) =>
Int -> t -> ShowS
recursiveShowsPrec

instance Recursive (->) [a] (XNor a) where
  cata :: forall a. Algebra (->) (XNor a) a -> [a] -> a
cata = Algebra (->) (XNor a) a -> [a] -> a
forall t (f :: * -> *) a.
(Projectable (->) t f, Functor f) =>
Algebra (->) f a -> t -> a
Unsafe.unsafeCata

instance Recursive (->) (NonEmpty a) (AndMaybe a) where
  cata :: forall a. Algebra (->) (AndMaybe a) a -> NonEmpty a -> a
cata = Algebra (->) (AndMaybe a) a -> NonEmpty a -> a
forall t (f :: * -> *) a.
(Projectable (->) t f, Functor f) =>
Algebra (->) f a -> t -> a
Unsafe.unsafeCata

instance (Functor f) => Recursive (->) (Cofree f a) (EnvT a f) where
  cata :: forall a. Algebra (->) (EnvT a f) a -> Cofree f a -> a
cata = Algebra (->) (EnvT a f) a -> Cofree f a -> a
forall t (f :: * -> *) a.
(Projectable (->) t f, Functor f) =>
Algebra (->) f a -> t -> a
Unsafe.unsafeCata

instance (Functor f) => Recursive (->) (Free f a) (FreeF f a) where
  cata :: forall a. Algebra (->) (FreeF f a) a -> Free f a -> a
cata = Algebra (->) (FreeF f a) a -> Free f a -> a
forall t (f :: * -> *) a.
(Projectable (->) t f, Functor f) =>
Algebra (->) f a -> t -> a
Unsafe.unsafeCata

-- TODO: If we can generalize this to an arbitrary 'Recursive (->) t (FreeF h a)'
--       then it would no longer be unsafe.
seqFreeT ::
  (Functor f, Functor h) =>
  DistributiveLaw (->) h f ->
  DistributiveLaw (->) (Free h) f
seqFreeT :: forall (f :: * -> *) (h :: * -> *).
(Functor f, Functor h) =>
DistributiveLaw (->) h f -> DistributiveLaw (->) (Free h) f
seqFreeT DistributiveLaw (->) h f
k =
  Algebra (->) (FreeF h (f a)) (f (Free h a))
-> FreeT h Identity (f a) -> f (Free h a)
forall a.
Algebra (->) (FreeF h (f a)) a -> FreeT h Identity (f a) -> a
forall {k} {k1} (c :: k -> k1 -> *) (t :: k) (f :: k1 -> k)
       (a :: k1).
Recursive c t f =>
Algebra c f a -> c t a
cata
    ( \case
        Pure f a
a -> FreeF h a (Free h a) -> Free h a
forall (f :: * -> *) a. FreeF f a (Free f a) -> Free f a
free (FreeF h a (Free h a) -> Free h a)
-> (a -> FreeF h a (Free h a)) -> a -> Free h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> FreeF h a (Free h a)
forall (f :: * -> *) a b. a -> FreeF f a b
Pure (a -> Free h a) -> f a -> f (Free h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a
        Free h (f (Free h a))
ft -> FreeF h a (Free h a) -> Free h a
forall (f :: * -> *) a. FreeF f a (Free f a) -> Free f a
free (FreeF h a (Free h a) -> Free h a)
-> (h (Free h a) -> FreeF h a (Free h a))
-> h (Free h a)
-> Free h a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. h (Free h a) -> FreeF h a (Free h a)
forall (f :: * -> *) a b. f b -> FreeF f a b
Free (h (Free h a) -> Free h a) -> f (h (Free h a)) -> f (Free h a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> h (f (Free h a)) -> f (h (Free h a))
DistributiveLaw (->) h f
k h (f (Free h a))
ft
    )

-- | `fromList` in this instance is unsafe, but `fromListN` is safe, because we
--   have a finite length to fold.
--
--   This means that most uses of @OverloadedLists@ should be fine, but not the
--   range (`..`) syntax.
instance IsList (Fix (XNor a)) where
  type Item (Fix (XNor a)) = a
  fromList :: [Item (Fix (XNor a))] -> Fix (XNor a)
fromList = [a] -> Fix (XNor a)
[Item (Fix (XNor a))] -> Fix (XNor a)
forall t a. Steppable (->) t (XNor a) => [a] -> t
unsafeFromList
  fromListN :: Int -> [Item (Fix (XNor a))] -> Fix (XNor a)
fromListN = Int -> [Item (Fix (XNor a))] -> Fix (XNor a)
forall l. IsList l => Int -> [Item l] -> l
fromListN
  toList :: Fix (XNor a) -> [Item (Fix (XNor a))]
toList = Fix (XNor a) -> [Item (Fix (XNor a))]
forall l. IsList l => l -> [Item l]
toList

-- | `fromList` in this instance is unsafe, but `fromListN` is safe, because we
--   have a finite length to fold.
--
--   This means that most uses of @OverloadedLists@ should be fine, but not the
--   range (`..`) syntax.
instance IsList (Mu (XNor a)) where
  type Item (Mu (XNor a)) = a
  fromList :: [Item (Mu (XNor a))] -> Mu (XNor a)
fromList = [a] -> Mu (XNor a)
[Item (Mu (XNor a))] -> Mu (XNor a)
forall t a. Steppable (->) t (XNor a) => [a] -> t
unsafeFromList
  fromListN :: Int -> [Item (Mu (XNor a))] -> Mu (XNor a)
fromListN = Int -> [Item (Mu (XNor a))] -> Mu (XNor a)
forall l. IsList l => Int -> [Item l] -> l
fromListN
  toList :: Mu (XNor a) -> [Item (Mu (XNor a))]
toList = Mu (XNor a) -> [Item (Mu (XNor a))]
forall l. IsList l => l -> [Item l]
toList