Generic.hs

{-# LANGUAGE CPP #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE UndecidableInstances #-}

{- |
  Compatibility copypasta from the future to derive Applicative without
  incurring dependency and boilerplate from "Distributive"/"Representable".
-}
module Resource.Collection.Generic
  ( Generic1(..)
  , Generically1(..)
  ) where

import RIO

import Control.Applicative (Alternative(..))
import Data.Kind (Type)
import GHC.Generics

#if !MIN_VERSION_base(4,17,0)

type    Generically1 :: forall k. (k -> Type) -> (k -> Type)
newtype Generically1 f a where
#if MIN_VERSION_base(4,16,0)
  -- Generically1 :: forall {k} f a. f a -> Generically1 @k f a
#endif
  Generically1 :: f a -> Generically1 f a

-- | @since 4.17.0.0
instance (Generic1 f, Functor (Rep1 f)) => Functor (Generically1 f) where
  fmap :: (a -> a') -> (Generically1 f a -> Generically1 f a')
  fmap f (Generically1 as) = Generically1
    (to1 (fmap f (from1 as)))

  (<$) :: a -> Generically1 f b -> Generically1 f a
  a <$ Generically1 as = Generically1
    (to1 (a <$ from1 as))

-- | @since 4.17.0.0
instance (Generic1 f, Applicative (Rep1 f)) => Applicative (Generically1 f) where
  pure :: a -> Generically1 f a
  pure a = Generically1
    (to1 (pure a))

  (<*>) :: Generically1 f (a1 -> a2) -> Generically1 f a1 -> Generically1 f a2
  Generically1 fs <*> Generically1 as = Generically1
    (to1 (from1 fs <*> from1 as))

  liftA2 :: (a1 -> a2 -> a3)
         -> (Generically1 f a1 -> Generically1 f a2 -> Generically1 f a3)
  liftA2 (·) (Generically1 as) (Generically1 bs) = Generically1
    (to1 (liftA2 (·) (from1 as) (from1 bs)))

-- | @since 4.17.0.0
instance (Generic1 f, Alternative (Rep1 f)) => Alternative (Generically1 f) where
  empty :: Generically1 f a
  empty = Generically1
    (to1 empty)

  (<|>) :: Generically1 f a -> Generically1 f a -> Generically1 f a
  Generically1 as1 <|> Generically1 as2 = Generically1
    (to1 (from1 as1 <|> from1 as2))

#endif