{-# LANGUAGE CPP #-}
#ifdef LANGUAGE_DeriveDataTypeable
{-# LANGUAGE DeriveDataTypeable #-}
#endif
#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif
#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
#endif
-- manual generics instances are not safe
#if __GLASGOW_HASKELL__ >= 707
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif

{-# OPTIONS_GHC -fno-warn-deprecations #-}
----------------------------------------------------------------------------
-- |
-- Module     : Data.Tagged
-- Copyright  : 2009-2015 Edward Kmett
-- License    : BSD3
--
-- Maintainer  : Edward Kmett <ekmett@gmail.com>
-- Stability   : experimental
-- Portability : portable
--
-------------------------------------------------------------------------------

module Data.Tagged
    (
    -- * Tagged values
      Tagged(..)
    , retag
    , untag
    , tagSelf
    , untagSelf
    , asTaggedTypeOf
    , witness
    -- * Conversion
    , proxy
    , unproxy
    , tagWith
    -- * Proxy methods GHC dropped
    , reproxy
    ) where

#if MIN_VERSION_base(4,8,0)
import Control.Applicative (liftA2)
#else
import Control.Applicative ((<$>), liftA2, Applicative(..))
import Data.Traversable (Traversable(..))
import Data.Monoid
#endif
import Data.Bits
import Data.Foldable (Foldable(..))
#ifdef MIN_VERSION_deepseq
import Control.DeepSeq (NFData(..))
#endif
#ifdef MIN_VERSION_transformers
import Data.Functor.Classes ( Eq1(..), Ord1(..), Read1(..), Show1(..)
# if !(MIN_VERSION_transformers(0,4,0)) || MIN_VERSION_transformers(0,5,0)
                            , Eq2(..), Ord2(..), Read2(..), Show2(..)
# endif
                            )
#endif
import Control.Monad (liftM)
#if MIN_VERSION_base(4,8,0)
import Data.Bifunctor
#endif
#if MIN_VERSION_base(4,10,0)
import Data.Bifoldable (Bifoldable(..))
import Data.Bitraversable (Bitraversable(..))
#endif
#ifdef __GLASGOW_HASKELL__
import Data.Data
#endif
import Data.Ix (Ix(..))
#if __GLASGOW_HASKELL__ < 707
import Data.Proxy
#endif
#if MIN_VERSION_base(4,9,0)
import Data.Semigroup (Semigroup(..))
#endif
import Data.String (IsString(..))
import Foreign.Ptr (castPtr)
import Foreign.Storable (Storable(..))
#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics (Generic)
#if __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic1)
#endif
#endif

-- | A @'Tagged' s b@ value is a value @b@ with an attached phantom type @s@.
-- This can be used in place of the more traditional but less safe idiom of
-- passing in an undefined value with the type, because unlike an @(s -> b)@,
-- a @'Tagged' s b@ can't try to use the argument @s@ as a real value.
--
-- Moreover, you don't have to rely on the compiler to inline away the extra
-- argument, because the newtype is \"free\"
--
-- 'Tagged' has kind @k -> * -> *@ if the compiler supports @PolyKinds@, therefore
-- there is an extra @k@ showing in the instance haddocks that may cause confusion.
newtype Tagged s b = Tagged { Tagged s b -> b
unTagged :: b } deriving
  ( Tagged s b -> Tagged s b -> Bool
(Tagged s b -> Tagged s b -> Bool)
-> (Tagged s b -> Tagged s b -> Bool) -> Eq (Tagged s b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (s :: k) b. Eq b => Tagged s b -> Tagged s b -> Bool
/= :: Tagged s b -> Tagged s b -> Bool
$c/= :: forall k (s :: k) b. Eq b => Tagged s b -> Tagged s b -> Bool
== :: Tagged s b -> Tagged s b -> Bool
$c== :: forall k (s :: k) b. Eq b => Tagged s b -> Tagged s b -> Bool
Eq, Eq (Tagged s b)
Eq (Tagged s b)
-> (Tagged s b -> Tagged s b -> Ordering)
-> (Tagged s b -> Tagged s b -> Bool)
-> (Tagged s b -> Tagged s b -> Bool)
-> (Tagged s b -> Tagged s b -> Bool)
-> (Tagged s b -> Tagged s b -> Bool)
-> (Tagged s b -> Tagged s b -> Tagged s b)
-> (Tagged s b -> Tagged s b -> Tagged s b)
-> Ord (Tagged s b)
Tagged s b -> Tagged s b -> Bool
Tagged s b -> Tagged s b -> Ordering
Tagged s b -> Tagged s b -> Tagged s b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (s :: k) b. Ord b => Eq (Tagged s b)
forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Bool
forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Ordering
forall k (s :: k) b.
Ord b =>
Tagged s b -> Tagged s b -> Tagged s b
min :: Tagged s b -> Tagged s b -> Tagged s b
$cmin :: forall k (s :: k) b.
Ord b =>
Tagged s b -> Tagged s b -> Tagged s b
max :: Tagged s b -> Tagged s b -> Tagged s b
$cmax :: forall k (s :: k) b.
Ord b =>
Tagged s b -> Tagged s b -> Tagged s b
>= :: Tagged s b -> Tagged s b -> Bool
$c>= :: forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Bool
> :: Tagged s b -> Tagged s b -> Bool
$c> :: forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Bool
<= :: Tagged s b -> Tagged s b -> Bool
$c<= :: forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Bool
< :: Tagged s b -> Tagged s b -> Bool
$c< :: forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Bool
compare :: Tagged s b -> Tagged s b -> Ordering
$ccompare :: forall k (s :: k) b. Ord b => Tagged s b -> Tagged s b -> Ordering
$cp1Ord :: forall k (s :: k) b. Ord b => Eq (Tagged s b)
Ord, Ord (Tagged s b)
Ord (Tagged s b)
-> ((Tagged s b, Tagged s b) -> [Tagged s b])
-> ((Tagged s b, Tagged s b) -> Tagged s b -> Int)
-> ((Tagged s b, Tagged s b) -> Tagged s b -> Int)
-> ((Tagged s b, Tagged s b) -> Tagged s b -> Bool)
-> ((Tagged s b, Tagged s b) -> Int)
-> ((Tagged s b, Tagged s b) -> Int)
-> Ix (Tagged s b)
(Tagged s b, Tagged s b) -> Int
(Tagged s b, Tagged s b) -> [Tagged s b]
(Tagged s b, Tagged s b) -> Tagged s b -> Bool
(Tagged s b, Tagged s b) -> Tagged s b -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
forall k (s :: k) b. Ix b => Ord (Tagged s b)
forall k (s :: k) b. Ix b => (Tagged s b, Tagged s b) -> Int
forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> [Tagged s b]
forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> Tagged s b -> Bool
forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> Tagged s b -> Int
unsafeRangeSize :: (Tagged s b, Tagged s b) -> Int
$cunsafeRangeSize :: forall k (s :: k) b. Ix b => (Tagged s b, Tagged s b) -> Int
rangeSize :: (Tagged s b, Tagged s b) -> Int
$crangeSize :: forall k (s :: k) b. Ix b => (Tagged s b, Tagged s b) -> Int
inRange :: (Tagged s b, Tagged s b) -> Tagged s b -> Bool
$cinRange :: forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> Tagged s b -> Bool
unsafeIndex :: (Tagged s b, Tagged s b) -> Tagged s b -> Int
$cunsafeIndex :: forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> Tagged s b -> Int
index :: (Tagged s b, Tagged s b) -> Tagged s b -> Int
$cindex :: forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> Tagged s b -> Int
range :: (Tagged s b, Tagged s b) -> [Tagged s b]
$crange :: forall k (s :: k) b.
Ix b =>
(Tagged s b, Tagged s b) -> [Tagged s b]
$cp1Ix :: forall k (s :: k) b. Ix b => Ord (Tagged s b)
Ix, Tagged s b
Tagged s b -> Tagged s b -> Bounded (Tagged s b)
forall a. a -> a -> Bounded a
forall k (s :: k) b. Bounded b => Tagged s b
maxBound :: Tagged s b
$cmaxBound :: forall k (s :: k) b. Bounded b => Tagged s b
minBound :: Tagged s b
$cminBound :: forall k (s :: k) b. Bounded b => Tagged s b
Bounded
#if __GLASGOW_HASKELL__ >= 702
  , (forall x. Tagged s b -> Rep (Tagged s b) x)
-> (forall x. Rep (Tagged s b) x -> Tagged s b)
-> Generic (Tagged s b)
forall x. Rep (Tagged s b) x -> Tagged s b
forall x. Tagged s b -> Rep (Tagged s b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (s :: k) b x. Rep (Tagged s b) x -> Tagged s b
forall k (s :: k) b x. Tagged s b -> Rep (Tagged s b) x
$cto :: forall k (s :: k) b x. Rep (Tagged s b) x -> Tagged s b
$cfrom :: forall k (s :: k) b x. Tagged s b -> Rep (Tagged s b) x
Generic
#if __GLASGOW_HASKELL__ >= 706
  , (forall a. Tagged s a -> Rep1 (Tagged s) a)
-> (forall a. Rep1 (Tagged s) a -> Tagged s a)
-> Generic1 (Tagged s)
forall a. Rep1 (Tagged s) a -> Tagged s a
forall a. Tagged s a -> Rep1 (Tagged s) a
forall k (s :: k) a. Rep1 (Tagged s) a -> Tagged s a
forall k (s :: k) a. Tagged s a -> Rep1 (Tagged s) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k (s :: k) a. Rep1 (Tagged s) a -> Tagged s a
$cfrom1 :: forall k (s :: k) a. Tagged s a -> Rep1 (Tagged s) a
Generic1
#endif
#endif

#if __GLASGOW_HASKELL__ >= 707
  , Typeable
#endif

  )

#ifdef __GLASGOW_HASKELL__
#if __GLASGOW_HASKELL__ < 707
instance Typeable2 Tagged where
  typeOf2 _ = mkTyConApp taggedTyCon []

taggedTyCon :: TyCon
#if __GLASGOW_HASKELL__ < 704
taggedTyCon = mkTyCon "Data.Tagged.Tagged"
#else
taggedTyCon = mkTyCon3 "tagged" "Data.Tagged" "Tagged"
#endif

#endif

instance (Data s, Data b) => Data (Tagged s b) where
  gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Tagged s b -> c (Tagged s b)
gfoldl forall d b. Data d => c (d -> b) -> d -> c b
f forall g. g -> c g
z (Tagged b
b) = (b -> Tagged s b) -> c (b -> Tagged s b)
forall g. g -> c g
z b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged c (b -> Tagged s b) -> b -> c (Tagged s b)
forall d b. Data d => c (d -> b) -> d -> c b
`f` b
b
  toConstr :: Tagged s b -> Constr
toConstr Tagged s b
_ = Constr
taggedConstr
  gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Tagged s b)
gunfold forall b r. Data b => c (b -> r) -> c r
k forall r. r -> c r
z Constr
c = case Constr -> Int
constrIndex Constr
c of
    Int
1 -> c (b -> Tagged s b) -> c (Tagged s b)
forall b r. Data b => c (b -> r) -> c r
k ((b -> Tagged s b) -> c (b -> Tagged s b)
forall r. r -> c r
z b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged)
    Int
_ -> [Char] -> c (Tagged s b)
forall a. HasCallStack => [Char] -> a
error [Char]
"gunfold"
  dataTypeOf :: Tagged s b -> DataType
dataTypeOf Tagged s b
_ = DataType
taggedDataType
  dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (Tagged s b))
dataCast1 forall d. Data d => c (t d)
f = c (t b) -> Maybe (c (Tagged s b))
forall k1 k2 (c :: k1 -> *) (t :: k2 -> k1) (t' :: k2 -> k1)
       (a :: k2).
(Typeable t, Typeable t') =>
c (t a) -> Maybe (c (t' a))
gcast1 c (t b)
forall d. Data d => c (t d)
f
  dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Tagged s b))
dataCast2 forall d e. (Data d, Data e) => c (t d e)
f = c (t s b) -> Maybe (c (Tagged s b))
forall k1 k2 k3 (c :: k1 -> *) (t :: k2 -> k3 -> k1)
       (t' :: k2 -> k3 -> k1) (a :: k2) (b :: k3).
(Typeable t, Typeable t') =>
c (t a b) -> Maybe (c (t' a b))
gcast2 c (t s b)
forall d e. (Data d, Data e) => c (t d e)
f

taggedConstr :: Constr
taggedConstr :: Constr
taggedConstr = DataType -> [Char] -> [[Char]] -> Fixity -> Constr
mkConstr DataType
taggedDataType [Char]
"Tagged" [] Fixity
Prefix
{-# INLINE taggedConstr #-}

taggedDataType :: DataType
taggedDataType :: DataType
taggedDataType = [Char] -> [Constr] -> DataType
mkDataType [Char]
"Data.Tagged.Tagged" [Constr
taggedConstr]
{-# INLINE taggedDataType #-}
#endif

instance Show b => Show (Tagged s b) where
    showsPrec :: Int -> Tagged s b -> ShowS
showsPrec Int
n (Tagged b
b) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"Tagged " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 b
b

instance Read b => Read (Tagged s b) where
    readsPrec :: Int -> ReadS (Tagged s b)
readsPrec Int
d = Bool -> ReadS (Tagged s b) -> ReadS (Tagged s b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Tagged s b) -> ReadS (Tagged s b))
-> ReadS (Tagged s b) -> ReadS (Tagged s b)
forall a b. (a -> b) -> a -> b
$ \[Char]
r ->
        [(b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged b
a, [Char]
t) | ([Char]
"Tagged", [Char]
s) <- ReadS [Char]
lex [Char]
r, (b
a, [Char]
t) <- Int -> ReadS b
forall a. Read a => Int -> ReadS a
readsPrec Int
11 [Char]
s]

#if MIN_VERSION_base(4,9,0)
instance Semigroup a => Semigroup (Tagged s a) where
    Tagged a
a <> :: Tagged s a -> Tagged s a -> Tagged s a
<> Tagged a
b = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a
a a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
b)
    stimes :: b -> Tagged s a -> Tagged s a
stimes b
n (Tagged a
a)  = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> a -> a
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes b
n a
a)

instance (Semigroup a, Monoid a) => Monoid (Tagged s a) where
    mempty :: Tagged s a
mempty = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
forall a. Monoid a => a
mempty
    mappend :: Tagged s a -> Tagged s a -> Tagged s a
mappend = Tagged s a -> Tagged s a -> Tagged s a
forall a. Semigroup a => a -> a -> a
(<>)
#else
instance Monoid a => Monoid (Tagged s a) where
    mempty = Tagged mempty
    mappend (Tagged a) (Tagged b) = Tagged (mappend a b)
#endif

instance Functor (Tagged s) where
    fmap :: (a -> b) -> Tagged s a -> Tagged s b
fmap a -> b
f (Tagged a
x) = b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> b
f a
x)
    {-# INLINE fmap #-}

#if MIN_VERSION_base(4,8,0)
-- this instance is provided by the bifunctors package for GHC<7.9
instance Bifunctor Tagged where
    bimap :: (a -> b) -> (c -> d) -> Tagged a c -> Tagged b d
bimap a -> b
_ c -> d
g (Tagged c
b) = d -> Tagged b d
forall k (s :: k) b. b -> Tagged s b
Tagged (c -> d
g c
b)
    {-# INLINE bimap #-}
#endif

#if MIN_VERSION_base(4,10,0)
-- these instances are provided by the bifunctors package for GHC<8.1
instance Bifoldable Tagged where
    bifoldMap :: (a -> m) -> (b -> m) -> Tagged a b -> m
bifoldMap a -> m
_ b -> m
g (Tagged b
b) = b -> m
g b
b
    {-# INLINE bifoldMap #-}

instance Bitraversable Tagged where
    bitraverse :: (a -> f c) -> (b -> f d) -> Tagged a b -> f (Tagged c d)
bitraverse a -> f c
_ b -> f d
g (Tagged b
b) = d -> Tagged c d
forall k (s :: k) b. b -> Tagged s b
Tagged (d -> Tagged c d) -> f d -> f (Tagged c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> f d
g b
b
    {-# INLINE bitraverse #-}
#endif

#ifdef MIN_VERSION_deepseq
instance NFData b => NFData (Tagged s b) where
    rnf :: Tagged s b -> ()
rnf (Tagged b
b) = b -> ()
forall a. NFData a => a -> ()
rnf b
b
#endif

#ifdef MIN_VERSION_transformers
# if MIN_VERSION_transformers(0,4,0) && !(MIN_VERSION_transformers(0,5,0))
instance Eq1 (Tagged s) where
    eq1 = (==)

instance Ord1 (Tagged s) where
    compare1 = compare

instance Read1 (Tagged s) where
    readsPrec1 = readsPrec

instance Show1 (Tagged s) where
    showsPrec1 = showsPrec
# else
instance Eq1 (Tagged s) where
    liftEq :: (a -> b -> Bool) -> Tagged s a -> Tagged s b -> Bool
liftEq a -> b -> Bool
eq (Tagged a
a) (Tagged b
b) = a -> b -> Bool
eq a
a b
b

instance Ord1 (Tagged s) where
    liftCompare :: (a -> b -> Ordering) -> Tagged s a -> Tagged s b -> Ordering
liftCompare a -> b -> Ordering
cmp (Tagged a
a) (Tagged b
b) = a -> b -> Ordering
cmp a
a b
b

instance Read1 (Tagged s) where
    liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Tagged s a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
_ Int
d = Bool -> ReadS (Tagged s a) -> ReadS (Tagged s a)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Tagged s a) -> ReadS (Tagged s a))
-> ReadS (Tagged s a) -> ReadS (Tagged s a)
forall a b. (a -> b) -> a -> b
$ \[Char]
r ->
        [(a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
a, [Char]
t) | ([Char]
"Tagged", [Char]
s) <- ReadS [Char]
lex [Char]
r, (a
a, [Char]
t) <- Int -> ReadS a
rp Int
11 [Char]
s]

instance Show1 (Tagged s) where
    liftShowsPrec :: (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> Tagged s a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
_ Int
n (Tagged a
b) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"Tagged " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> a -> ShowS
sp Int
11 a
b

instance Eq2 Tagged where
    liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> Tagged a c -> Tagged b d -> Bool
liftEq2 a -> b -> Bool
_ c -> d -> Bool
eq (Tagged c
a) (Tagged d
b) = c -> d -> Bool
eq c
a d
b

instance Ord2 Tagged where
    liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Tagged a c -> Tagged b d -> Ordering
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
cmp (Tagged c
a) (Tagged d
b) = c -> d -> Ordering
cmp c
a d
b

instance Read2 Tagged where
    liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Tagged a b)
liftReadsPrec2 Int -> ReadS a
_ ReadS [a]
_ Int -> ReadS b
rp ReadS [b]
_ Int
d = Bool -> ReadS (Tagged a b) -> ReadS (Tagged a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Tagged a b) -> ReadS (Tagged a b))
-> ReadS (Tagged a b) -> ReadS (Tagged a b)
forall a b. (a -> b) -> a -> b
$ \[Char]
r ->
        [(b -> Tagged a b
forall k (s :: k) b. b -> Tagged s b
Tagged b
a, [Char]
t) | ([Char]
"Tagged", [Char]
s) <- ReadS [Char]
lex [Char]
r, (b
a, [Char]
t) <- Int -> ReadS b
rp Int
11 [Char]
s]

instance Show2 Tagged where
    liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Tagged a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
sp [b] -> ShowS
_ Int
n (Tagged b
b) = Bool -> ShowS -> ShowS
showParen (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
        [Char] -> ShowS
showString [Char]
"Tagged " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        Int -> b -> ShowS
sp Int
11 b
b
# endif
#endif

instance Applicative (Tagged s) where
    pure :: a -> Tagged s a
pure = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged
    {-# INLINE pure #-}
    Tagged a -> b
f <*> :: Tagged s (a -> b) -> Tagged s a -> Tagged s b
<*> Tagged a
x = b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> b
f a
x)
    {-# INLINE (<*>) #-}
    Tagged s a
_ *> :: Tagged s a -> Tagged s b -> Tagged s b
*> Tagged s b
n = Tagged s b
n
    {-# INLINE (*>) #-}

instance Monad (Tagged s) where
    return :: a -> Tagged s a
return = a -> Tagged s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    {-# INLINE return #-}
    Tagged a
m >>= :: Tagged s a -> (a -> Tagged s b) -> Tagged s b
>>= a -> Tagged s b
k = a -> Tagged s b
k a
m
    {-# INLINE (>>=) #-}
    >> :: Tagged s a -> Tagged s b -> Tagged s b
(>>) = Tagged s a -> Tagged s b -> Tagged s b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
    {-# INLINE (>>) #-}

instance Foldable (Tagged s) where
    foldMap :: (a -> m) -> Tagged s a -> m
foldMap a -> m
f (Tagged a
x) = a -> m
f a
x
    {-# INLINE foldMap #-}
    fold :: Tagged s m -> m
fold (Tagged m
x) = m
x
    {-# INLINE fold #-}
    foldr :: (a -> b -> b) -> b -> Tagged s a -> b
foldr a -> b -> b
f b
z (Tagged a
x) = a -> b -> b
f a
x b
z
    {-# INLINE foldr #-}
    foldl :: (b -> a -> b) -> b -> Tagged s a -> b
foldl b -> a -> b
f b
z (Tagged a
x) = b -> a -> b
f b
z a
x
    {-# INLINE foldl #-}
    foldl1 :: (a -> a -> a) -> Tagged s a -> a
foldl1 a -> a -> a
_ (Tagged a
x) = a
x
    {-# INLINE foldl1 #-}
    foldr1 :: (a -> a -> a) -> Tagged s a -> a
foldr1 a -> a -> a
_ (Tagged a
x) = a
x
    {-# INLINE foldr1 #-}

instance Traversable (Tagged s) where
    traverse :: (a -> f b) -> Tagged s a -> f (Tagged s b)
traverse a -> f b
f (Tagged a
x) = b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> Tagged s b) -> f b -> f (Tagged s b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
x
    {-# INLINE traverse #-}
    sequenceA :: Tagged s (f a) -> f (Tagged s a)
sequenceA (Tagged f a
x) = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> f a -> f (Tagged s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
x
    {-# INLINE sequenceA #-}
    mapM :: (a -> m b) -> Tagged s a -> m (Tagged s b)
mapM a -> m b
f (Tagged a
x) = (b -> Tagged s b) -> m b -> m (Tagged s b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Tagged s b
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> m b
f a
x)
    {-# INLINE mapM #-}
    sequence :: Tagged s (m a) -> m (Tagged s a)
sequence (Tagged m a
x) = (a -> Tagged s a) -> m a -> m (Tagged s a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged m a
x
    {-# INLINE sequence #-}

instance Enum a => Enum (Tagged s a) where
    succ :: Tagged s a -> Tagged s a
succ = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Enum a => a -> a
succ
    pred :: Tagged s a -> Tagged s a
pred = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Enum a => a -> a
pred
    toEnum :: Int -> Tagged s a
toEnum = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> (Int -> a) -> Int -> Tagged s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum
    fromEnum :: Tagged s a -> Int
fromEnum (Tagged a
x) = a -> Int
forall a. Enum a => a -> Int
fromEnum a
x
    enumFrom :: Tagged s a -> [Tagged s a]
enumFrom (Tagged a
x) = (a -> Tagged s a) -> [a] -> [Tagged s a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> [a]
forall a. Enum a => a -> [a]
enumFrom a
x)
    enumFromThen :: Tagged s a -> Tagged s a -> [Tagged s a]
enumFromThen (Tagged a
x) (Tagged a
y) = (a -> Tagged s a) -> [a] -> [Tagged s a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromThen a
x a
y)
    enumFromTo :: Tagged s a -> Tagged s a -> [Tagged s a]
enumFromTo (Tagged a
x) (Tagged a
y) = (a -> Tagged s a) -> [a] -> [Tagged s a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> a -> [a]
forall a. Enum a => a -> a -> [a]
enumFromTo a
x a
y)
    enumFromThenTo :: Tagged s a -> Tagged s a -> Tagged s a -> [Tagged s a]
enumFromThenTo (Tagged a
x) (Tagged a
y) (Tagged a
z) =
        (a -> Tagged s a) -> [a] -> [Tagged s a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> a -> a -> [a]
forall a. Enum a => a -> a -> a -> [a]
enumFromThenTo a
x a
y a
z)

instance Num a => Num (Tagged s a) where
    + :: Tagged s a -> Tagged s a -> Tagged s a
(+) = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
    (-) = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
    * :: Tagged s a -> Tagged s a -> Tagged s a
(*) = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
    negate :: Tagged s a -> Tagged s a
negate = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
    abs :: Tagged s a -> Tagged s a
abs = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
    signum :: Tagged s a -> Tagged s a
signum = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
    fromInteger :: Integer -> Tagged s a
fromInteger = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> (Integer -> a) -> Integer -> Tagged s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger

instance Real a => Real (Tagged s a) where
    toRational :: Tagged s a -> Rational
toRational (Tagged a
x) = a -> Rational
forall a. Real a => a -> Rational
toRational a
x

instance Integral a => Integral (Tagged s a) where
    quot :: Tagged s a -> Tagged s a -> Tagged s a
quot = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
quot
    rem :: Tagged s a -> Tagged s a -> Tagged s a
rem = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
rem
    div :: Tagged s a -> Tagged s a -> Tagged s a
div = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
div
    mod :: Tagged s a -> Tagged s a -> Tagged s a
mod = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
mod
    quotRem :: Tagged s a -> Tagged s a -> (Tagged s a, Tagged s a)
quotRem (Tagged a
x) (Tagged a
y) = (a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
a, a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
b) where
        (a
a, a
b) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
x a
y
    divMod :: Tagged s a -> Tagged s a -> (Tagged s a, Tagged s a)
divMod (Tagged a
x) (Tagged a
y) = (a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
a, a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
b) where
        (a
a, a
b) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
divMod a
x a
y
    toInteger :: Tagged s a -> Integer
toInteger (Tagged a
x) = a -> Integer
forall a. Integral a => a -> Integer
toInteger a
x

instance Fractional a => Fractional (Tagged s a) where
    / :: Tagged s a -> Tagged s a -> Tagged s a
(/) = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
    recip :: Tagged s a -> Tagged s a
recip = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
    fromRational :: Rational -> Tagged s a
fromRational = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> (Rational -> a) -> Rational -> Tagged s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

instance Floating a => Floating (Tagged s a) where
    pi :: Tagged s a
pi = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
forall a. Floating a => a
pi
    exp :: Tagged s a -> Tagged s a
exp = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
    log :: Tagged s a -> Tagged s a
log = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
    sqrt :: Tagged s a -> Tagged s a
sqrt = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
    sin :: Tagged s a -> Tagged s a
sin = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
    cos :: Tagged s a -> Tagged s a
cos = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
    tan :: Tagged s a -> Tagged s a
tan = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tan
    asin :: Tagged s a -> Tagged s a
asin = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
    acos :: Tagged s a -> Tagged s a
acos = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
    atan :: Tagged s a -> Tagged s a
atan = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
    sinh :: Tagged s a -> Tagged s a
sinh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
    cosh :: Tagged s a -> Tagged s a
cosh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
    tanh :: Tagged s a -> Tagged s a
tanh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
tanh
    asinh :: Tagged s a -> Tagged s a
asinh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
    acosh :: Tagged s a -> Tagged s a
acosh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
    atanh :: Tagged s a -> Tagged s a
atanh = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
    ** :: Tagged s a -> Tagged s a -> Tagged s a
(**) = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
    logBase :: Tagged s a -> Tagged s a -> Tagged s a
logBase = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase

instance RealFrac a => RealFrac (Tagged s a) where
    properFraction :: Tagged s a -> (b, Tagged s a)
properFraction (Tagged a
x) = (b
a, a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
b) where
        (b
a, a
b) = a -> (b, a)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction a
x
    truncate :: Tagged s a -> b
truncate (Tagged a
x) = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate a
x
    round :: Tagged s a -> b
round (Tagged a
x) = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
round a
x
    ceiling :: Tagged s a -> b
ceiling (Tagged a
x) = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling a
x
    floor :: Tagged s a -> b
floor (Tagged a
x) = a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x

instance RealFloat a => RealFloat (Tagged s a) where
    floatRadix :: Tagged s a -> Integer
floatRadix (Tagged a
x) = a -> Integer
forall a. RealFloat a => a -> Integer
floatRadix a
x
    floatDigits :: Tagged s a -> Int
floatDigits (Tagged a
x) = a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x
    floatRange :: Tagged s a -> (Int, Int)
floatRange (Tagged a
x) = a -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange a
x
    decodeFloat :: Tagged s a -> (Integer, Int)
decodeFloat (Tagged a
x) = a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x
    encodeFloat :: Integer -> Int -> Tagged s a
encodeFloat Integer
m Int
n = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
m Int
n)
    exponent :: Tagged s a -> Int
exponent (Tagged a
x) = a -> Int
forall a. RealFloat a => a -> Int
exponent a
x
    significand :: Tagged s a -> Tagged s a
significand = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. RealFloat a => a -> a
significand
    scaleFloat :: Int -> Tagged s a -> Tagged s a
scaleFloat Int
n = (a -> a) -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a -> a
forall a. RealFloat a => Int -> a -> a
scaleFloat Int
n)
    isNaN :: Tagged s a -> Bool
isNaN (Tagged a
x) = a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x
    isInfinite :: Tagged s a -> Bool
isInfinite (Tagged a
x) = a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x
    isDenormalized :: Tagged s a -> Bool
isDenormalized (Tagged a
x) = a -> Bool
forall a. RealFloat a => a -> Bool
isDenormalized a
x
    isNegativeZero :: Tagged s a -> Bool
isNegativeZero (Tagged a
x) = a -> Bool
forall a. RealFloat a => a -> Bool
isNegativeZero a
x
    isIEEE :: Tagged s a -> Bool
isIEEE (Tagged a
x) = a -> Bool
forall a. RealFloat a => a -> Bool
isIEEE a
x
    atan2 :: Tagged s a -> Tagged s a -> Tagged s a
atan2 = (a -> a -> a) -> Tagged s a -> Tagged s a -> Tagged s a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. RealFloat a => a -> a -> a
atan2

instance Bits a => Bits (Tagged s a) where
    Tagged a
a .&. :: Tagged s a -> Tagged s a -> Tagged s a
.&. Tagged a
b = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a
a a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
b)
    Tagged a
a .|. :: Tagged s a -> Tagged s a -> Tagged s a
.|. Tagged a
b = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a
a a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
b)
    xor :: Tagged s a -> Tagged s a -> Tagged s a
xor (Tagged a
a) (Tagged a
b) = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> a -> a
forall a. Bits a => a -> a -> a
xor a
a a
b)
    complement :: Tagged s a -> Tagged s a
complement (Tagged a
a) = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> a
forall a. Bits a => a -> a
complement a
a)
    shift :: Tagged s a -> Int -> Tagged s a
shift (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
shift a
a Int
i)
    shiftL :: Tagged s a -> Int -> Tagged s a
shiftL (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
a Int
i)
    shiftR :: Tagged s a -> Int -> Tagged s a
shiftR (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
a Int
i)
    rotate :: Tagged s a -> Int -> Tagged s a
rotate (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
rotate a
a Int
i)
    rotateL :: Tagged s a -> Int -> Tagged s a
rotateL (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateL a
a Int
i)
    rotateR :: Tagged s a -> Int -> Tagged s a
rotateR (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
rotateR a
a Int
i)
    bit :: Int -> Tagged s a
bit Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (Int -> a
forall a. Bits a => Int -> a
bit Int
i)
    setBit :: Tagged s a -> Int -> Tagged s a
setBit (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
setBit a
a Int
i)
    clearBit :: Tagged s a -> Int -> Tagged s a
clearBit (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
clearBit a
a Int
i)
    complementBit :: Tagged s a -> Int -> Tagged s a
complementBit (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
complementBit a
a Int
i)
    testBit :: Tagged s a -> Int -> Bool
testBit (Tagged a
a) Int
i = a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
a Int
i
    isSigned :: Tagged s a -> Bool
isSigned (Tagged a
a) = a -> Bool
forall a. Bits a => a -> Bool
isSigned a
a
    bitSize :: Tagged s a -> Int
bitSize (Tagged a
a) = a -> Int
forall a. Bits a => a -> Int
bitSize a
a -- deprecated, but still required :(
#if MIN_VERSION_base(4,5,0)
    unsafeShiftL :: Tagged s a -> Int -> Tagged s a
unsafeShiftL (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftL a
a Int
i)
    unsafeShiftR :: Tagged s a -> Int -> Tagged s a
unsafeShiftR (Tagged a
a) Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Int -> a
forall a. Bits a => a -> Int -> a
unsafeShiftR a
a Int
i)
    popCount :: Tagged s a -> Int
popCount (Tagged a
a) = a -> Int
forall a. Bits a => a -> Int
popCount a
a
#endif
#if MIN_VERSION_base(4,7,0)
    bitSizeMaybe :: Tagged s a -> Maybe Int
bitSizeMaybe (Tagged a
a) = a -> Maybe Int
forall a. Bits a => a -> Maybe Int
bitSizeMaybe a
a
    zeroBits :: Tagged s a
zeroBits = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
forall a. Bits a => a
zeroBits
#endif

#if MIN_VERSION_base(4,7,0)
instance FiniteBits a => FiniteBits (Tagged s a) where
    finiteBitSize :: Tagged s a -> Int
finiteBitSize (Tagged a
a) = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a
# if MIN_VERSION_base(4,8,0)
    countLeadingZeros :: Tagged s a -> Int
countLeadingZeros (Tagged a
a) = a -> Int
forall b. FiniteBits b => b -> Int
countLeadingZeros a
a
    countTrailingZeros :: Tagged s a -> Int
countTrailingZeros (Tagged a
a) = a -> Int
forall b. FiniteBits b => b -> Int
countTrailingZeros a
a
# endif
#endif

instance IsString a => IsString (Tagged s a) where
    fromString :: [Char] -> Tagged s a
fromString = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> ([Char] -> a) -> [Char] -> Tagged s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> a
forall a. IsString a => [Char] -> a
fromString

instance Storable a => Storable (Tagged s a) where
    sizeOf :: Tagged s a -> Int
sizeOf Tagged s a
t = a -> Int
forall a. Storable a => a -> Int
sizeOf a
a
      where
        Tagged a
a = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
forall a. HasCallStack => a
undefined Tagged s a -> Tagged s a -> Tagged s a
forall a. a -> a -> a
`asTypeOf` Tagged s a
t
    alignment :: Tagged s a -> Int
alignment Tagged s a
t = a -> Int
forall a. Storable a => a -> Int
alignment a
a
      where
        Tagged a
a = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged a
forall a. HasCallStack => a
undefined Tagged s a -> Tagged s a -> Tagged s a
forall a. a -> a -> a
`asTypeOf` Tagged s a
t
    peek :: Ptr (Tagged s a) -> IO (Tagged s a)
peek Ptr (Tagged s a)
ptr = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> IO a -> IO (Tagged s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek (Ptr (Tagged s a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Tagged s a)
ptr)
    poke :: Ptr (Tagged s a) -> Tagged s a -> IO ()
poke Ptr (Tagged s a)
ptr (Tagged a
a) = Ptr a -> a -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr (Tagged s a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Tagged s a)
ptr) a
a
    peekElemOff :: Ptr (Tagged s a) -> Int -> IO (Tagged s a)
peekElemOff Ptr (Tagged s a)
ptr Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> IO a -> IO (Tagged s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr a -> Int -> IO a
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff (Ptr (Tagged s a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Tagged s a)
ptr) Int
i
    pokeElemOff :: Ptr (Tagged s a) -> Int -> Tagged s a -> IO ()
pokeElemOff Ptr (Tagged s a)
ptr Int
i (Tagged a
a) = Ptr a -> Int -> a -> IO ()
forall a. Storable a => Ptr a -> Int -> a -> IO ()
pokeElemOff (Ptr (Tagged s a) -> Ptr a
forall a b. Ptr a -> Ptr b
castPtr Ptr (Tagged s a)
ptr) Int
i a
a
    peekByteOff :: Ptr b -> Int -> IO (Tagged s a)
peekByteOff Ptr b
ptr Int
i = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (a -> Tagged s a) -> IO a -> IO (Tagged s a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Any -> Int -> IO a
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff (Ptr b -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) Int
i
    pokeByteOff :: Ptr b -> Int -> Tagged s a -> IO ()
pokeByteOff Ptr b
ptr Int
i (Tagged a
a) = Ptr Any -> Int -> a -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff (Ptr b -> Ptr Any
forall a b. Ptr a -> Ptr b
castPtr Ptr b
ptr) Int
i a
a

-- | Some times you need to change the tag you have lying around.
-- Idiomatic usage is to make a new combinator for the relationship between the
-- tags that you want to enforce, and define that combinator using 'retag'.
--
-- @
-- data Succ n
-- retagSucc :: 'Tagged' n a -> 'Tagged' (Succ n) a
-- retagSucc = 'retag'
-- @
retag :: Tagged s b -> Tagged t b
retag :: Tagged s b -> Tagged t b
retag = b -> Tagged t b
forall k (s :: k) b. b -> Tagged s b
Tagged (b -> Tagged t b) -> (Tagged s b -> b) -> Tagged s b -> Tagged t b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tagged s b -> b
forall k (s :: k) b. Tagged s b -> b
unTagged
{-# INLINE retag #-}

-- | Alias for 'unTagged'
untag :: Tagged s b -> b
untag :: Tagged s b -> b
untag = Tagged s b -> b
forall k (s :: k) b. Tagged s b -> b
unTagged

-- | Tag a value with its own type.
tagSelf :: a -> Tagged a a
tagSelf :: a -> Tagged a a
tagSelf = a -> Tagged a a
forall k (s :: k) b. b -> Tagged s b
Tagged
{-# INLINE tagSelf #-}

-- | 'asTaggedTypeOf' is a type-restricted version of 'const'. It is usually used as an infix operator, and its typing forces its first argument (which is usually overloaded) to have the same type as the tag of the second.
asTaggedTypeOf :: s -> tagged s b -> s
asTaggedTypeOf :: s -> tagged s b -> s
asTaggedTypeOf = s -> tagged s b -> s
forall a b. a -> b -> a
const
{-# INLINE asTaggedTypeOf #-}

witness :: Tagged a b -> a -> b
witness :: Tagged a b -> a -> b
witness (Tagged b
b) a
_ = b
b
{-# INLINE witness #-}

-- | 'untagSelf' is a type-restricted version of 'untag'.
untagSelf :: Tagged a a -> a
untagSelf :: Tagged a a -> a
untagSelf (Tagged a
x) = a
x
{-# INLINE untagSelf #-}

-- | Convert from a 'Tagged' representation to a representation
-- based on a 'Proxy'.
proxy :: Tagged s a -> proxy s -> a
proxy :: Tagged s a -> proxy s -> a
proxy (Tagged a
x) proxy s
_ = a
x
{-# INLINE proxy #-}

-- | Convert from a representation based on a 'Proxy' to a 'Tagged'
-- representation.
unproxy :: (Proxy s -> a) -> Tagged s a
unproxy :: (Proxy s -> a) -> Tagged s a
unproxy Proxy s -> a
f = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged (Proxy s -> a
f Proxy s
forall k (t :: k). Proxy t
Proxy)
{-# INLINE unproxy #-}

-- | Another way to convert a proxy to a tag.
tagWith :: proxy s -> a -> Tagged s a
tagWith :: proxy s -> a -> Tagged s a
tagWith proxy s
_ = a -> Tagged s a
forall k (s :: k) b. b -> Tagged s b
Tagged
{-# INLINE tagWith #-}

-- | Some times you need to change the proxy you have lying around.
-- Idiomatic usage is to make a new combinator for the relationship
-- between the proxies that you want to enforce, and define that
-- combinator using 'reproxy'.
--
-- @
-- data Succ n
-- reproxySucc :: proxy n -> 'Proxy' (Succ n)
-- reproxySucc = 'reproxy'
-- @
reproxy :: proxy a -> Proxy b
reproxy :: proxy a -> Proxy b
reproxy proxy a
_ = Proxy b
forall k (t :: k). Proxy t
Proxy