{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE Trustworthy #-}
#if __GLASGOW_HASKELL__ >= 810
{-# LANGUAGE StandaloneKindSignatures #-}
#endif
module Data.Some.Newtype (
Some(Some),
mkSome,
withSome,
withSomeM,
mapSome,
foldSome,
traverseSome,
) where
import Control.Applicative (Applicative (..))
import Control.DeepSeq (NFData (..))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup (..))
import GHC.Exts (Any)
import Unsafe.Coerce (unsafeCoerce)
#if __GLASGOW_HASKELL__ >= 810
import Data.Kind (Type)
#endif
import Data.GADT.Compare
import Data.GADT.DeepSeq
import Data.GADT.Show
#if __GLASGOW_HASKELL__ >= 810
type Some :: (k -> Type) -> Type
#endif
newtype Some tag = UnsafeSome (tag Any)
type role Some representational
{-# COMPLETE Some #-}
pattern Some :: tag a -> Some tag
pattern $bSome :: forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
$mSome :: forall {r} {k} {tag :: k -> *}.
Some tag -> (forall {a :: k}. tag a -> r) -> ((# #) -> r) -> r
Some x <- UnsafeSome x
where Some tag a
x = forall k (tag :: k -> *). tag Any -> Some tag
UnsafeSome ((forall a b. a -> b
unsafeCoerce :: tag a -> tag Any) tag a
x)
mkSome :: tag a -> Some tag
mkSome :: forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome = \tag a
x -> forall k (tag :: k -> *). tag Any -> Some tag
UnsafeSome (forall a b. a -> b
unsafeCoerce tag a
x)
withSome :: Some tag -> (forall a. tag a -> b) -> b
withSome :: forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome (UnsafeSome tag Any
thing) forall (a :: k). tag a -> b
some = forall (a :: k). tag a -> b
some (forall a b. a -> b
unsafeCoerce tag Any
thing)
withSomeM :: Monad m => m (Some tag) -> (forall a. tag a -> m r) -> m r
withSomeM :: forall {k} (m :: * -> *) (tag :: k -> *) r.
Monad m =>
m (Some tag) -> (forall (a :: k). tag a -> m r) -> m r
withSomeM m (Some tag)
m forall (a :: k). tag a -> m r
k = m (Some tag)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Some tag
s -> forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
s forall (a :: k). tag a -> m r
k
foldSome :: (forall a. tag a -> b) -> Some tag -> b
foldSome :: forall {k} (tag :: k -> *) b.
(forall (a :: k). tag a -> b) -> Some tag -> b
foldSome forall (a :: k). tag a -> b
some (UnsafeSome tag Any
thing) = forall (a :: k). tag a -> b
some (forall a b. a -> b
unsafeCoerce tag Any
thing)
mapSome :: (forall t. f t -> g t) -> Some f -> Some g
mapSome :: forall {k} (f :: k -> *) (g :: k -> *).
(forall (t :: k). f t -> g t) -> Some f -> Some g
mapSome forall (t :: k). f t -> g t
f (UnsafeSome f Any
x) = forall k (tag :: k -> *). tag Any -> Some tag
UnsafeSome (forall a b. a -> b
unsafeCoerce forall (t :: k). f t -> g t
f f Any
x)
traverseSome :: Functor m => (forall a. f a -> m (g a)) -> Some f -> m (Some g)
traverseSome :: forall {k} (m :: * -> *) (f :: k -> *) (g :: k -> *).
Functor m =>
(forall (a :: k). f a -> m (g a)) -> Some f -> m (Some g)
traverseSome forall (a :: k). f a -> m (g a)
f Some f
x = forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some f
x forall a b. (a -> b) -> a -> b
$ \f a
x' -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome (forall (a :: k). f a -> m (g a)
f f a
x')
instance GShow tag => Show (Some tag) where
showsPrec :: Int -> Some tag -> ShowS
showsPrec Int
p Some tag
some = forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
some forall a b. (a -> b) -> a -> b
$ \tag a
thing -> Bool -> ShowS -> ShowS
showParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10)
( String -> ShowS
showString String
"Some "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k (t :: k -> *) (a :: k). GShow t => Int -> t a -> ShowS
gshowsPrec Int
11 tag a
thing
)
instance GRead f => Read (Some f) where
readsPrec :: Int -> ReadS (Some f)
readsPrec Int
p = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
10) forall a b. (a -> b) -> a -> b
$ \String
s ->
[ (forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
getGReadResult Some f
withTag forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome, String
rest')
| (String
con, String
rest) <- ReadS String
lex String
s
, String
con forall a. Eq a => a -> a -> Bool
== String
"Some" Bool -> Bool -> Bool
|| String
con forall a. Eq a => a -> a -> Bool
== String
"mkSome"
, (Some f
withTag, String
rest') <- forall k (t :: k -> *). GRead t => Int -> GReadS t
greadsPrec Int
11 String
rest
]
instance GEq tag => Eq (Some tag) where
Some tag
x == :: Some tag -> Some tag -> Bool
== Some tag
y =
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
x forall a b. (a -> b) -> a -> b
$ \tag a
x' ->
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
y forall a b. (a -> b) -> a -> b
$ \tag a
y' -> forall {k} (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Bool
defaultEq tag a
x' tag a
y'
instance GCompare tag => Ord (Some tag) where
compare :: Some tag -> Some tag -> Ordering
compare Some tag
x Some tag
y =
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
x forall a b. (a -> b) -> a -> b
$ \tag a
x' ->
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
y forall a b. (a -> b) -> a -> b
$ \tag a
y' -> forall {k} (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> Ordering
defaultCompare tag a
x' tag a
y'
instance GNFData tag => NFData (Some tag) where
rnf :: Some tag -> ()
rnf Some tag
x = forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some tag
x forall k (f :: k -> *) (a :: k). GNFData f => f a -> ()
grnf
instance Control.Applicative.Applicative m => Data.Semigroup.Semigroup (Some m) where
Some m
m <> :: Some m -> Some m -> Some m
<> Some m
n =
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some m
m forall a b. (a -> b) -> a -> b
$ \m a
m' ->
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
withSome Some m
n forall a b. (a -> b) -> a -> b
$ \m a
n' ->
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome (m a
m' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
n')
instance Applicative m => Data.Monoid.Monoid (Some m) where
mempty :: Some m
mempty = forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
mkSome (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
mappend :: Some m -> Some m -> Some m
mappend = forall a. Semigroup a => a -> a -> a
(<>)