{-| A tradgey has befallen us.
  Newtypes, something intended to be a zero-cost abstraction is having a cost.
  May the phantoms save us.
-}


{-# LANGUAGE AllowAmbiguousTypes        #-}
{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeOperators              #-}
#ifdef Typed
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
#endif


module Data.Spooky (
    Spooky
  -- * Ghostly relation
  , type (👻)(..)
  -- * Coercion
  , traumatize, terrify
  -- * Standard toolchain
  , mapSpooky, applySpooky, bindSpooky, hoistSpooky
  -- * Lift arguments
  , liftSpooky, liftSpooky2, liftSpooky3, liftSpooky4, liftSpooky5
  ) where


import           Data.Kind
#ifdef Typed
import           GHC.Generics
#endif


{-| Spooky is either a newtype over @s@, or a type alias of @s@ depending on the cabal flag -untyped.
    @a@ is always a phantom type. The haddock is somewhat misleading here, as it's compiled typed
    and therefore reflects the newtyped representation below.
-}
#ifdef Typed
newtype Spooky (s :: Type) (a :: Type) = Spooky s
  deriving newtype (Spooky s a -> Spooky s a -> Bool
(Spooky s a -> Spooky s a -> Bool)
-> (Spooky s a -> Spooky s a -> Bool) -> Eq (Spooky s a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall s a. Eq s => Spooky s a -> Spooky s a -> Bool
/= :: Spooky s a -> Spooky s a -> Bool
$c/= :: forall s a. Eq s => Spooky s a -> Spooky s a -> Bool
== :: Spooky s a -> Spooky s a -> Bool
$c== :: forall s a. Eq s => Spooky s a -> Spooky s a -> Bool
Eq, Eq (Spooky s a)
Eq (Spooky s a)
-> (Spooky s a -> Spooky s a -> Ordering)
-> (Spooky s a -> Spooky s a -> Bool)
-> (Spooky s a -> Spooky s a -> Bool)
-> (Spooky s a -> Spooky s a -> Bool)
-> (Spooky s a -> Spooky s a -> Bool)
-> (Spooky s a -> Spooky s a -> Spooky s a)
-> (Spooky s a -> Spooky s a -> Spooky s a)
-> Ord (Spooky s a)
Spooky s a -> Spooky s a -> Bool
Spooky s a -> Spooky s a -> Ordering
Spooky s a -> Spooky s a -> Spooky s a
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 s a. Ord s => Eq (Spooky s a)
forall s a. Ord s => Spooky s a -> Spooky s a -> Bool
forall s a. Ord s => Spooky s a -> Spooky s a -> Ordering
forall s a. Ord s => Spooky s a -> Spooky s a -> Spooky s a
min :: Spooky s a -> Spooky s a -> Spooky s a
$cmin :: forall s a. Ord s => Spooky s a -> Spooky s a -> Spooky s a
max :: Spooky s a -> Spooky s a -> Spooky s a
$cmax :: forall s a. Ord s => Spooky s a -> Spooky s a -> Spooky s a
>= :: Spooky s a -> Spooky s a -> Bool
$c>= :: forall s a. Ord s => Spooky s a -> Spooky s a -> Bool
> :: Spooky s a -> Spooky s a -> Bool
$c> :: forall s a. Ord s => Spooky s a -> Spooky s a -> Bool
<= :: Spooky s a -> Spooky s a -> Bool
$c<= :: forall s a. Ord s => Spooky s a -> Spooky s a -> Bool
< :: Spooky s a -> Spooky s a -> Bool
$c< :: forall s a. Ord s => Spooky s a -> Spooky s a -> Bool
compare :: Spooky s a -> Spooky s a -> Ordering
$ccompare :: forall s a. Ord s => Spooky s a -> Spooky s a -> Ordering
$cp1Ord :: forall s a. Ord s => Eq (Spooky s a)
Ord, Int -> Spooky s a -> ShowS
[Spooky s a] -> ShowS
Spooky s a -> String
(Int -> Spooky s a -> ShowS)
-> (Spooky s a -> String)
-> ([Spooky s a] -> ShowS)
-> Show (Spooky s a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall s a. Show s => Int -> Spooky s a -> ShowS
forall s a. Show s => [Spooky s a] -> ShowS
forall s a. Show s => Spooky s a -> String
showList :: [Spooky s a] -> ShowS
$cshowList :: forall s a. Show s => [Spooky s a] -> ShowS
show :: Spooky s a -> String
$cshow :: forall s a. Show s => Spooky s a -> String
showsPrec :: Int -> Spooky s a -> ShowS
$cshowsPrec :: forall s a. Show s => Int -> Spooky s a -> ShowS
Show, ReadPrec [Spooky s a]
ReadPrec (Spooky s a)
Int -> ReadS (Spooky s a)
ReadS [Spooky s a]
(Int -> ReadS (Spooky s a))
-> ReadS [Spooky s a]
-> ReadPrec (Spooky s a)
-> ReadPrec [Spooky s a]
-> Read (Spooky s a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall s a. Read s => ReadPrec [Spooky s a]
forall s a. Read s => ReadPrec (Spooky s a)
forall s a. Read s => Int -> ReadS (Spooky s a)
forall s a. Read s => ReadS [Spooky s a]
readListPrec :: ReadPrec [Spooky s a]
$creadListPrec :: forall s a. Read s => ReadPrec [Spooky s a]
readPrec :: ReadPrec (Spooky s a)
$creadPrec :: forall s a. Read s => ReadPrec (Spooky s a)
readList :: ReadS [Spooky s a]
$creadList :: forall s a. Read s => ReadS [Spooky s a]
readsPrec :: Int -> ReadS (Spooky s a)
$creadsPrec :: forall s a. Read s => Int -> ReadS (Spooky s a)
Read, Int -> Spooky s a
Spooky s a -> Int
Spooky s a -> [Spooky s a]
Spooky s a -> Spooky s a
Spooky s a -> Spooky s a -> [Spooky s a]
Spooky s a -> Spooky s a -> Spooky s a -> [Spooky s a]
(Spooky s a -> Spooky s a)
-> (Spooky s a -> Spooky s a)
-> (Int -> Spooky s a)
-> (Spooky s a -> Int)
-> (Spooky s a -> [Spooky s a])
-> (Spooky s a -> Spooky s a -> [Spooky s a])
-> (Spooky s a -> Spooky s a -> [Spooky s a])
-> (Spooky s a -> Spooky s a -> Spooky s a -> [Spooky s a])
-> Enum (Spooky s a)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
forall s a. Enum s => Int -> Spooky s a
forall s a. Enum s => Spooky s a -> Int
forall s a. Enum s => Spooky s a -> [Spooky s a]
forall s a. Enum s => Spooky s a -> Spooky s a
forall s a. Enum s => Spooky s a -> Spooky s a -> [Spooky s a]
forall s a.
Enum s =>
Spooky s a -> Spooky s a -> Spooky s a -> [Spooky s a]
enumFromThenTo :: Spooky s a -> Spooky s a -> Spooky s a -> [Spooky s a]
$cenumFromThenTo :: forall s a.
Enum s =>
Spooky s a -> Spooky s a -> Spooky s a -> [Spooky s a]
enumFromTo :: Spooky s a -> Spooky s a -> [Spooky s a]
$cenumFromTo :: forall s a. Enum s => Spooky s a -> Spooky s a -> [Spooky s a]
enumFromThen :: Spooky s a -> Spooky s a -> [Spooky s a]
$cenumFromThen :: forall s a. Enum s => Spooky s a -> Spooky s a -> [Spooky s a]
enumFrom :: Spooky s a -> [Spooky s a]
$cenumFrom :: forall s a. Enum s => Spooky s a -> [Spooky s a]
fromEnum :: Spooky s a -> Int
$cfromEnum :: forall s a. Enum s => Spooky s a -> Int
toEnum :: Int -> Spooky s a
$ctoEnum :: forall s a. Enum s => Int -> Spooky s a
pred :: Spooky s a -> Spooky s a
$cpred :: forall s a. Enum s => Spooky s a -> Spooky s a
succ :: Spooky s a -> Spooky s a
$csucc :: forall s a. Enum s => Spooky s a -> Spooky s a
Enum, Spooky s a
Spooky s a -> Spooky s a -> Bounded (Spooky s a)
forall a. a -> a -> Bounded a
forall s a. Bounded s => Spooky s a
maxBound :: Spooky s a
$cmaxBound :: forall s a. Bounded s => Spooky s a
minBound :: Spooky s a
$cminBound :: forall s a. Bounded s => Spooky s a
Bounded)
  deriving stock (forall x. Spooky s a -> Rep (Spooky s a) x)
-> (forall x. Rep (Spooky s a) x -> Spooky s a)
-> Generic (Spooky s a)
forall x. Rep (Spooky s a) x -> Spooky s a
forall x. Spooky s a -> Rep (Spooky s a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s a x. Rep (Spooky s a) x -> Spooky s a
forall s a x. Spooky s a -> Rep (Spooky s a) x
$cto :: forall s a x. Rep (Spooky s a) x -> Spooky s a
$cfrom :: forall s a x. Spooky s a -> Rep (Spooky s a) x
Generic
#else
type Spooky (s :: Type) (a :: Type) = s
#endif


{-| The class of semantic types that can be converted to and from Spooky.
  Typically these methods are defined in terms of @terrify@ and @traumatize@
-}
class s 👻 a where
  {-# MINIMAL unSpooky, toSpooky #-}
  -- | Convert @s@ to @a@
  unSpooky :: Spooky s a -> a
  -- | Convert @a@ to @s@
  toSpooky :: a -> Spooky s a


-- | Scooby pulled the mask off and it was farmer @s@ the whole time.
terrify :: Spooky s a -> s
#ifdef Typed
terrify :: Spooky s a -> s
terrify (Spooky s
s) = s
s
#else
terrify = id
#endif
{-# INLINE terrify #-}


-- | Now @s@ masquerades around like it was converted from @a@.
-- This function should be considered regrettable, and perhaps
-- only used in the definition of a 👻 instance. This function
-- breaks any guarentee that we had, that @a@ is semantic for @s@.
-- Use with care.
traumatize :: s -> Spooky s a
#ifdef Typed
traumatize :: s -> Spooky s a
traumatize = s -> Spooky s a
forall s a. s -> Spooky s a
Spooky
#else
traumatize = id
#endif
{-# INLINE traumatize #-}


-- | Spooky is a Functor, but we cannot make a type class instance for it
-- because type aliases cannot be curried in Haskell
mapSpooky :: (s 👻 a, s 👻 b) => (a -> b) -> Spooky s a -> Spooky s b
mapSpooky :: (a -> b) -> Spooky s a -> Spooky s b
mapSpooky a -> b
f = b -> Spooky s b
forall s a. (s 👻 a) => a -> Spooky s a
toSpooky (b -> Spooky s b) -> (Spooky s a -> b) -> Spooky s a -> Spooky s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f (a -> b) -> (Spooky s a -> a) -> Spooky s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky
{-# INLINE mapSpooky #-}


-- | Applicative operation for Spooky
applySpooky :: forall s a b. (s 👻 (a -> b), s 👻 a, s 👻 b) => Spooky s (a -> b) -> Spooky s a -> Spooky s b
applySpooky :: Spooky s (a -> b) -> Spooky s a -> Spooky s b
applySpooky Spooky s (a -> b)
sf = b -> Spooky s b
forall s a. (s 👻 a) => a -> Spooky s a
toSpooky (b -> Spooky s b) -> (Spooky s a -> b) -> Spooky s a -> Spooky s b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Spooky s (a -> b) -> a -> b
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s (a -> b)
sf :: a -> b) (a -> b) -> (Spooky s a -> a) -> Spooky s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky
{-# INLINE applySpooky #-}


-- | Monadic operation for Spooky
bindSpooky :: s 👻 a => Spooky s a -> (a -> Spooky s b) -> Spooky s b
bindSpooky :: Spooky s a -> (a -> Spooky s b) -> Spooky s b
bindSpooky Spooky s a
sa a -> Spooky s b
f = a -> Spooky s b
f (a -> Spooky s b) -> a -> Spooky s b
forall a b. (a -> b) -> a -> b
$ Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s a
sa
{-# INLINE bindSpooky #-}


-- | When the villian actually does change
hoistSpooky :: (s -> s') -> Spooky s a -> Spooky s' a
hoistSpooky :: (s -> s') -> Spooky s a -> Spooky s' a
hoistSpooky s -> s'
f = s' -> Spooky s' a
forall s a. s -> Spooky s a
traumatize (s' -> Spooky s' a)
-> (Spooky s a -> s') -> Spooky s a -> Spooky s' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> s'
f (s -> s') -> (Spooky s a -> s) -> Spooky s a -> s'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spooky s a -> s
forall s a. Spooky s a -> s
terrify
{-# INLINE hoistSpooky #-}


-- | Lift the argument of a function into Spooky
liftSpooky :: s 👻 a => (a -> b) -> Spooky s a -> b
liftSpooky :: (a -> b) -> Spooky s a -> b
liftSpooky a -> b
f = a -> b
f (a -> b) -> (Spooky s a -> a) -> Spooky s a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky
{-# INLINE liftSpooky #-}


liftSpooky2
  :: (s 👻 a, s 👻 b)
  => (a -> b -> c) -> Spooky s a -> Spooky s b -> c
liftSpooky2 :: (a -> b -> c) -> Spooky s a -> Spooky s b -> c
liftSpooky2 a -> b -> c
f Spooky s a
a Spooky s b
b = a -> b -> c
f (Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s a
a) (Spooky s b -> b
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s b
b)
{-# INLINE liftSpooky2 #-}


liftSpooky3
  :: (s 👻 a, s 👻 b, s 👻 c)
  => (a -> b -> c -> d) -> Spooky s a -> Spooky s b -> Spooky s c -> d
liftSpooky3 :: (a -> b -> c -> d) -> Spooky s a -> Spooky s b -> Spooky s c -> d
liftSpooky3 a -> b -> c -> d
f Spooky s a
a Spooky s b
b Spooky s c
c = a -> b -> c -> d
f (Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s a
a) (Spooky s b -> b
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s b
b) (Spooky s c -> c
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s c
c)
{-# INLINE liftSpooky3 #-}


liftSpooky4
  :: (s 👻 a, s 👻 b, s 👻 c, s 👻 d)
  => (a -> b -> c -> d -> e) -> Spooky s a -> Spooky s b -> Spooky s c -> Spooky s d -> e
liftSpooky4 :: (a -> b -> c -> d -> e)
-> Spooky s a -> Spooky s b -> Spooky s c -> Spooky s d -> e
liftSpooky4 a -> b -> c -> d -> e
f Spooky s a
a Spooky s b
b Spooky s c
c Spooky s d
d = a -> b -> c -> d -> e
f (Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s a
a) (Spooky s b -> b
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s b
b) (Spooky s c -> c
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s c
c) (Spooky s d -> d
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s d
d)
{-# INLINE liftSpooky4 #-}


liftSpooky5
  :: (s 👻 a, s 👻 b, s 👻 c, s 👻 d, s 👻 e)
  => (a -> b -> c -> d -> e -> f) -> Spooky s a -> Spooky s b -> Spooky s c -> Spooky s d -> Spooky s e -> f
liftSpooky5 :: (a -> b -> c -> d -> e -> f)
-> Spooky s a
-> Spooky s b
-> Spooky s c
-> Spooky s d
-> Spooky s e
-> f
liftSpooky5 a -> b -> c -> d -> e -> f
f Spooky s a
a Spooky s b
b Spooky s c
c Spooky s d
d Spooky s e
e = a -> b -> c -> d -> e -> f
f (Spooky s a -> a
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s a
a) (Spooky s b -> b
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s b
b) (Spooky s c -> c
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s c
c) (Spooky s d -> d
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s d
d) (Spooky s e -> e
forall s a. (s 👻 a) => Spooky s a -> a
unSpooky Spooky s e
e)
{-# INLINE liftSpooky5 #-}