{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Options.Harg.Single
( Single (..),
single,
fromSingle,
)
where
import qualified Barbies as B
import qualified Data.Aeson as JSON
import Data.Functor.Identity (Identity (..))
import qualified Data.Functor.Product as P
import Data.Kind (Type)
import GHC.Generics (Generic)
newtype Single (a :: Type) (f :: Type -> Type) = Single
{ Single a f -> f a
getSingle :: f a
}
single :: f a -> Single a f
single :: f a -> Single a f
single = f a -> Single a f
forall a (f :: * -> *). f a -> Single a f
Single
fromSingle :: Single a Identity -> a
fromSingle :: Single a Identity -> a
fromSingle = Identity a -> a
forall a. Identity a -> a
runIdentity (Identity a -> a)
-> (Single a Identity -> Identity a) -> Single a Identity -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Single a Identity -> Identity a
forall a (f :: * -> *). Single a f -> f a
getSingle
deriving instance (Show a, Show (f a)) => Show (Single a f)
deriving newtype instance Generic (f a) => Generic (Single a f)
deriving newtype instance JSON.FromJSON (f a) => JSON.FromJSON (Single a f)
instance B.FunctorB (Single a) where
bmap :: (forall a. f a -> g a) -> Single a f -> Single a g
bmap nat :: forall a. f a -> g a
nat (Single p :: f a
p) = g a -> Single a g
forall a (f :: * -> *). f a -> Single a f
Single (f a -> g a
forall a. f a -> g a
nat f a
p)
instance B.TraversableB (Single a) where
btraverse :: (forall a. f a -> e (g a)) -> Single a f -> e (Single a g)
btraverse nat :: forall a. f a -> e (g a)
nat (Single p :: f a
p) = g a -> Single a g
forall a (f :: * -> *). f a -> Single a f
Single (g a -> Single a g) -> e (g a) -> e (Single a g)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a -> e (g a)
forall a. f a -> e (g a)
nat f a
p
instance B.ApplicativeB (Single a) where
bprod :: Single a f -> Single a g -> Single a (Product f g)
bprod (Single l :: f a
l) (Single r :: g a
r) = Product f g a -> Single a (Product f g)
forall a (f :: * -> *). f a -> Single a f
Single (f a -> g a -> Product f g a
forall k (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
P.Pair f a
l g a
r)
bpure :: (forall a. f a) -> Single a f
bpure = (forall a. f a) -> Single a f
forall a (f :: * -> *). f a -> Single a f
Single