{-# OPTIONS_GHC -Wno-orphans #-} module ZkFold.Base.Data.List.Infinite where import Data.Distributive (Distributive (..)) import Data.Function ((.)) import Data.Functor.Rep (Representable (..), distributeRep) import Data.List.Infinite (Infinite) import qualified Data.List.Infinite as Inf import GHC.Real (fromIntegral) import Numeric.Natural (Natural) instance Distributive Infinite where distribute :: forall (f :: Type -> Type) a. Functor f => f (Infinite a) -> Infinite (f a) distribute = f (Infinite a) -> Infinite (f a) forall (f :: Type -> Type) (w :: Type -> Type) a. (Representable f, Functor w) => w (f a) -> f (w a) distributeRep instance Representable Infinite where type Rep Infinite = Natural tabulate :: forall a. (Rep Infinite -> a) -> Infinite a tabulate = (Word -> a) -> Infinite a forall a. (Word -> a) -> Infinite a Inf.tabulate ((Word -> a) -> Infinite a) -> ((Natural -> a) -> Word -> a) -> (Natural -> a) -> Infinite a forall b c a. (b -> c) -> (a -> b) -> a -> c . ((Natural -> a) -> (Word -> Natural) -> Word -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Word -> Natural forall a b. (Integral a, Num b) => a -> b fromIntegral) index :: forall a. Infinite a -> Rep Infinite -> a index = ((Word -> a) -> (Natural -> Word) -> Natural -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Natural -> Word forall a b. (Integral a, Num b) => a -> b fromIntegral) ((Word -> a) -> Natural -> a) -> (Infinite a -> Word -> a) -> Infinite a -> Natural -> a forall b c a. (b -> c) -> (a -> b) -> a -> c . Infinite a -> Word -> a forall a. Infinite a -> Word -> a (Inf.!!)