(original) (raw)

{-# LANGUAGE Trustworthy #-} {-# LANGUAGE NoImplicitPrelude #-}

module Data.Functor.Utils where

import Data.Coerce (Coercible, coerce) import GHC.Base ( Applicative(..), Functor(..), Maybe(..), Monoid(..), Ord(..) , Semigroup(..), ($), otherwise )

newtype Max a = Max {forall a. Max a -> Maybe a getMax :: Maybe a} newtype Min a = Min {forall a. Min a -> Maybe a getMin :: Maybe a}

instance Ord a => Semigroup (Max a) where {-# INLINE (<>) #-} Max a m <> :: Max a -> Max a -> Max a <> Max Maybe a Nothing = Max a m Max Maybe a Nothing <> Max a n = Max a n (Max m :: Maybe a m@(Just a x)) <> (Max n :: Maybe a n@(Just a y)) | a x a -> a -> Bool forall a. Ord a => a -> a -> Bool >= a y = Maybe a -> Max a forall a. Maybe a -> Max a Max Maybe a m | Bool otherwise = Maybe a -> Max a forall a. Maybe a -> Max a Max Maybe a n

instance Ord a => Monoid (Max a) where mempty :: Max a mempty = Maybe a -> Max a forall a. Maybe a -> Max a Max Maybe a forall a. Maybe a Nothing

instance Ord a => Semigroup (Min a) where {-# INLINE (<>) #-} Min a m <> :: Min a -> Min a -> Min a <> Min Maybe a Nothing = Min a m Min Maybe a Nothing <> Min a n = Min a n (Min m :: Maybe a m@(Just a x)) <> (Min n :: Maybe a n@(Just a y)) | a x a -> a -> Bool forall a. Ord a => a -> a -> Bool <= a y = Maybe a -> Min a forall a. Maybe a -> Min a Min Maybe a m | Bool otherwise = Maybe a -> Min a forall a. Maybe a -> Min a Min Maybe a n

instance Ord a => Monoid (Min a) where mempty :: Min a mempty = Maybe a -> Min a forall a. Maybe a -> Min a Min Maybe a forall a. Maybe a Nothing

newtype StateL s a = StateL { forall s a. StateL s a -> s -> (s, a) runStateL :: s -> (s, a) }

instance Functor (StateL s) where fmap :: forall a b. (a -> b) -> StateL s a -> StateL s b fmap a -> b f (StateL s -> (s, a) k) = (s -> (s, b)) -> StateL s b forall s a. (s -> (s, a)) -> StateL s a StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b forall a b. (a -> b) -> a -> b $ \ s s -> let (s s', a v) = s -> (s, a) k s s in (s s', a -> b f a v)

instance Applicative (StateL s) where pure :: forall a. a -> StateL s a pure a x = (s -> (s, a)) -> StateL s a forall s a. (s -> (s, a)) -> StateL s a StateL (\ s s -> (s s, a x)) StateL s -> (s, a -> b) kf <*> :: forall a b. StateL s (a -> b) -> StateL s a -> StateL s b <*> StateL s -> (s, a) kv = (s -> (s, b)) -> StateL s b forall s a. (s -> (s, a)) -> StateL s a StateL ((s -> (s, b)) -> StateL s b) -> (s -> (s, b)) -> StateL s b forall a b. (a -> b) -> a -> b $ \ s s -> let (s s', a -> b f) = s -> (s, a -> b) kf s s (s s'', a v) = s -> (s, a) kv s s' in (s s'', a -> b f a v) liftA2 :: forall a b c. (a -> b -> c) -> StateL s a -> StateL s b -> StateL s c liftA2 a -> b -> c f (StateL s -> (s, a) kx) (StateL s -> (s, b) ky) = (s -> (s, c)) -> StateL s c forall s a. (s -> (s, a)) -> StateL s a StateL ((s -> (s, c)) -> StateL s c) -> (s -> (s, c)) -> StateL s c forall a b. (a -> b) -> a -> b $ \s s -> let (s s', a x) = s -> (s, a) kx s s (s s'', b y) = s -> (s, b) ky s s' in (s s'', a -> b -> c f a x b y)

newtype StateR s a = StateR { forall s a. StateR s a -> s -> (s, a) runStateR :: s -> (s, a) }

instance Functor (StateR s) where fmap :: forall a b. (a -> b) -> StateR s a -> StateR s b fmap a -> b f (StateR s -> (s, a) k) = (s -> (s, b)) -> StateR s b forall s a. (s -> (s, a)) -> StateR s a StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b forall a b. (a -> b) -> a -> b $ \ s s -> let (s s', a v) = s -> (s, a) k s s in (s s', a -> b f a v)

instance Applicative (StateR s) where pure :: forall a. a -> StateR s a pure a x = (s -> (s, a)) -> StateR s a forall s a. (s -> (s, a)) -> StateR s a StateR (\ s s -> (s s, a x)) StateR s -> (s, a -> b) kf <*> :: forall a b. StateR s (a -> b) -> StateR s a -> StateR s b <*> StateR s -> (s, a) kv = (s -> (s, b)) -> StateR s b forall s a. (s -> (s, a)) -> StateR s a StateR ((s -> (s, b)) -> StateR s b) -> (s -> (s, b)) -> StateR s b forall a b. (a -> b) -> a -> b $ \ s s -> let (s s', a v) = s -> (s, a) kv s s (s s'', a -> b f) = s -> (s, a -> b) kf s s' in (s s'', a -> b f a v) liftA2 :: forall a b c. (a -> b -> c) -> StateR s a -> StateR s b -> StateR s c liftA2 a -> b -> c f (StateR s -> (s, a) kx) (StateR s -> (s, b) ky) = (s -> (s, c)) -> StateR s c forall s a. (s -> (s, a)) -> StateR s a StateR ((s -> (s, c)) -> StateR s c) -> (s -> (s, c)) -> StateR s c forall a b. (a -> b) -> a -> b $ \ s s -> let (s s', b y) = s -> (s, b) ky s s (s s'', a x) = s -> (s, a) kx s s' in (s s'', a -> b -> c f a x b y)

(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c) #. :: forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c (#.) b -> c _f = (a -> b) -> a -> c coerce {-# INLINE (#.) #-}