    {-# 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

    -- $setup
    -- >>> :set -XKindSignatures -XGADTs
    -- >>> import Data.GADT.Show

    -- | Existential. This is type is useful to hide GADTs' parameters.
    --
    -- >>> data Tag :: * -> * where TagInt :: Tag Int; TagBool :: Tag Bool
    -- >>> instance GShow Tag where gshowsPrec _ TagInt = showString "TagInt"; gshowsPrec _ TagBool = showString "TagBool"
    -- >>> classify s = case s of "TagInt" -> [mkGReadResult TagInt]; "TagBool" -> [mkGReadResult TagBool]; _ -> []
    -- >>> instance GRead Tag where greadsPrec _ s = [ (r, rest) | (con, rest) <-  lex s, r <- classify con ]
    --
    -- You can either use @PatternSynonyms@ (available with GHC >= 8.0)
    --
    -- >>> let x = Some TagInt
    -- >>> x
    -- Some TagInt
    --
    -- >>> case x of { Some TagInt -> "I"; Some TagBool -> "B" } :: String
    -- "I"
    --
    -- or you can use functions
    --
    -- >>> let y = mkSome TagBool
    -- >>> y
    -- Some TagBool
    --
    -- >>> withSome y $ \y' -> case y' of { TagInt -> "I"; TagBool -> "B" } :: String
    -- "B"
    --
    -- The implementation of 'mapSome' is /safe/.
    --
    -- >>> let f :: Tag a -> Tag a; f TagInt = TagInt; f TagBool = TagBool
    -- >>> mapSome f y
    -- Some TagBool
    --
    -- but you can also use:
    --
    -- >>> withSome y (mkSome . f)
    -- Some TagBool
    --
    -- >>> read "Some TagBool" :: Some Tag
    -- Some TagBool
    --
    -- >>> read "mkSome TagInt" :: Some Tag
    -- Some TagInt
    --
    #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 $mSome :: forall {r} {k} {tag :: k -> *}.
    Some tag -> (forall {a :: k}. tag a -> r) -> ((# #) -> r) -> r
    $bSome :: forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    Some x <- UnsafeSome x
      where Some tag a
    x = tag Any -> Some tag
    forall k (tag :: k -> *). tag Any -> Some tag
    UnsafeSome ((tag a -> tag Any
    forall a b. a -> b
    forall {k} {tag :: k -> *} {a :: k}. tag a -> tag Any
    unsafeCoerce :: tag a -> tag Any) tag a
    x)

    -- | Constructor.
    mkSome :: tag a -> Some tag
    mkSome :: forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    mkSome = \tag a
    x -> tag Any -> Some tag
    forall k (tag :: k -> *). tag Any -> Some tag
    UnsafeSome (tag a -> tag Any
    forall a b. a -> b
    unsafeCoerce tag a
    x)

    -- | Eliminator.
    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 = tag Any -> b
    forall (a :: k). tag a -> b
    some (tag Any -> tag Any
    forall a b. a -> b
    unsafeCoerce tag Any
    thing)

    -- | Monadic 'withSome'.
    --
    -- @since 1.0.1
    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 m (Some tag) -> (Some tag -> m r) -> m r
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Some tag
    s -> Some tag -> (forall (a :: k). tag a -> m r) -> m r
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    s tag a -> m r
    forall (a :: k). tag a -> m r
    k

    -- | @'flip' 'withSome'@
    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) = tag Any -> b
    forall (a :: k). tag a -> b
    some (tag Any -> tag Any
    forall a b. a -> b
    unsafeCoerce tag Any
    thing)

    -- | Map over argument.
    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) = g Any -> Some g
    forall k (tag :: k -> *). tag Any -> Some tag
    UnsafeSome ((f Any -> g Any) -> f Any -> g Any
    forall a b. a -> b
    unsafeCoerce f Any -> g Any
    forall (t :: k). f t -> g t
    f f Any
    x)

    -- | Traverse over argument.
    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 = Some f -> (forall {a :: k}. f a -> m (Some g)) -> m (Some g)
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some f
    x ((forall {a :: k}. f a -> m (Some g)) -> m (Some g))
    -> (forall {a :: k}. f a -> m (Some g)) -> m (Some g)
    forall a b. (a -> b) -> a -> b
    $ \f a
    x' -> (g a -> Some g) -> m (g a) -> m (Some g)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap g a -> Some g
    forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    mkSome (f a -> m (g a)
    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 = Some tag -> (forall {a :: k}. tag a -> ShowS) -> ShowS
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    some ((forall {a :: k}. tag a -> ShowS) -> ShowS)
    -> (forall {a :: k}. tag a -> ShowS) -> ShowS
    forall a b. (a -> b) -> a -> b
    $ \tag a
    thing -> Bool -> ShowS -> ShowS
    showParen (Int
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    10)
            ( String -> ShowS
    showString String
    "Some "
            ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> tag a -> ShowS
    forall (a :: k). Int -> tag a -> ShowS
    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 = Bool -> ReadS (Some f) -> ReadS (Some f)
    forall a. Bool -> ReadS a -> ReadS a
    readParen (Int
    pInt -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >Int
    10) (ReadS (Some f) -> ReadS (Some f))
    -> ReadS (Some f) -> ReadS (Some f)
    forall a b. (a -> b) -> a -> b
    $ \String
    s ->
            [ (Some f -> (forall (a :: k). f a -> Some f) -> Some f
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    getGReadResult Some f
    withTag f a -> Some f
    forall (a :: k). f a -> Some f
    forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    mkSome, String
    rest')
            | (String
    con, String
    rest) <- ReadS String
    lex String
    s
            , String
    con String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "Some" Bool -> Bool -> Bool
    || String
    con String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "mkSome"
            , (Some f
    withTag, String
    rest') <- Int -> GReadS f
    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 =
            Some tag -> (forall {a :: k}. tag a -> Bool) -> Bool
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    x ((forall {a :: k}. tag a -> Bool) -> Bool)
    -> (forall {a :: k}. tag a -> Bool) -> Bool
    forall a b. (a -> b) -> a -> b
    $ \tag a
    x' ->
            Some tag -> (forall {a :: k}. tag a -> Bool) -> Bool
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    y ((forall {a :: k}. tag a -> Bool) -> Bool)
    -> (forall {a :: k}. tag a -> Bool) -> Bool
    forall a b. (a -> b) -> a -> b
    $ \tag a
    y' -> tag a -> tag a -> Bool
    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 =
            Some tag -> (forall {a :: k}. tag a -> Ordering) -> Ordering
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    x ((forall {a :: k}. tag a -> Ordering) -> Ordering)
    -> (forall {a :: k}. tag a -> Ordering) -> Ordering
    forall a b. (a -> b) -> a -> b
    $ \tag a
    x' ->
            Some tag -> (forall {a :: k}. tag a -> Ordering) -> Ordering
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    y ((forall {a :: k}. tag a -> Ordering) -> Ordering)
    -> (forall {a :: k}. tag a -> Ordering) -> Ordering
    forall a b. (a -> b) -> a -> b
    $ \tag a
    y' -> tag a -> tag a -> Ordering
    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 = Some tag -> (forall (a :: k). tag a -> ()) -> ()
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some tag
    x tag a -> ()
    forall (a :: k). tag a -> ()
    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 =
            Some m -> (forall {a}. m a -> Some m) -> Some m
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some m
    m ((forall {a}. m a -> Some m) -> Some m)
    -> (forall {a}. m a -> Some m) -> Some m
    forall a b. (a -> b) -> a -> b
    $ \m a
    m' ->
            Some m -> (forall {a}. m a -> Some m) -> Some m
    forall {k} (tag :: k -> *) b.
    Some tag -> (forall (a :: k). tag a -> b) -> b
    withSome Some m
    n ((forall {a}. m a -> Some m) -> Some m)
    -> (forall {a}. m a -> Some m) -> Some m
    forall a b. (a -> b) -> a -> b
    $ \m a
    n' ->
            m a -> Some m
    forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    mkSome (m a
    m' m a -> m a -> m a
    forall a b. m a -> m b -> m b
    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 = m () -> Some m
    forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
    mkSome (() -> m ()
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ())
        mappend :: Some m -> Some m -> Some m
    mappend = Some m -> Some m -> Some m
    forall a. Semigroup a => a -> a -> a
    (<>)