{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Trustworthy #-}
module Control.Monad.Skeleton.Internal (Cat(..), transCat, (|>), viewL, transKleisli) where

import Control.Arrow
import Unsafe.Coerce

-- | Type-aligned catenable queue
data Cat k a b where
  Leaf :: k a b -> Cat k a b
  Tree :: Cat k a b -> Cat k b c -> Cat k a c

transCat :: (forall x y. j x y -> k x y) -> Cat j a b -> Cat k a b
transCat :: forall {k} (j :: k -> k -> *) (k :: k -> k -> *) (a :: k) (b :: k).
(forall (x :: k) (y :: k). j x y -> k x y)
-> Cat j a b -> Cat k a b
transCat forall (x :: k) (y :: k). j x y -> k x y
f (Tree Cat j a b
a Cat j b b
b) = (forall (x :: k) (y :: k). j x y -> k x y)
-> Cat j a b -> Cat k a b
forall {k} (j :: k -> k -> *) (k :: k -> k -> *) (a :: k) (b :: k).
(forall (x :: k) (y :: k). j x y -> k x y)
-> Cat j a b -> Cat k a b
transCat forall (x :: k) (y :: k). j x y -> k x y
f Cat j a b
a Cat k a b -> Cat k b b -> Cat k a b
forall {k} (k :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Cat k a b -> Cat k b c -> Cat k a c
`Tree` (forall (x :: k) (y :: k). j x y -> k x y)
-> Cat j b b -> Cat k b b
forall {k} (j :: k -> k -> *) (k :: k -> k -> *) (a :: k) (b :: k).
(forall (x :: k) (y :: k). j x y -> k x y)
-> Cat j a b -> Cat k a b
transCat forall (x :: k) (y :: k). j x y -> k x y
f Cat j b b
b
transCat forall (x :: k) (y :: k). j x y -> k x y
f (Leaf j a b
k) = k a b -> Cat k a b
forall {k} (k :: k -> k -> *) (a :: k) (b :: k). k a b -> Cat k a b
Leaf (j a b -> k a b
forall (x :: k) (y :: k). j x y -> k x y
f j a b
k)
{-# INLINE transCat #-}

(|>) :: Cat k a b -> k b c -> Cat k a c
Cat k a b
s |> :: forall {k} (k :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Cat k a b -> k b c -> Cat k a c
|> k b c
k = Cat k a b -> Cat k b c -> Cat k a c
forall {k} (k :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Cat k a b -> Cat k b c -> Cat k a c
Tree Cat k a b
s (k b c -> Cat k b c
forall {k} (k :: k -> k -> *) (a :: k) (b :: k). k a b -> Cat k a b
Leaf k b c
k)
{-# INLINE (|>) #-}

-- | Match on the leftmost element. It gradually rotates the nodes so that following calls to 'viewL' is faster.
viewL :: forall k a b r. Cat k a b
  -> (k a b -> r)
  -> (forall x. k a x -> Cat k x b -> r)
  -> r
viewL :: forall {k} (k :: k -> k -> *) (a :: k) (b :: k) r.
Cat k a b
-> (k a b -> r) -> (forall (x :: k). k a x -> Cat k x b -> r) -> r
viewL (Leaf k a b
k) k a b -> r
e forall (x :: k). k a x -> Cat k x b -> r
_ = k a b -> r
e k a b
k
viewL (Tree Cat k a b
a Cat k b b
b) k a b -> r
_ forall (x :: k). k a x -> Cat k x b -> r
r = Cat k a b -> Cat k b b -> r
forall (x :: k). Cat k a x -> Cat k x b -> r
go Cat k a b
a Cat k b b
b where
  go :: Cat k a x -> Cat k x b -> r
  go :: forall (x :: k). Cat k a x -> Cat k x b -> r
go (Leaf k a x
k) Cat k x b
t = k a x -> Cat k x b -> r
forall (x :: k). k a x -> Cat k x b -> r
r k a x
k Cat k x b
t
  go (Tree Cat k a b
c Cat k b x
d) Cat k x b
t = Cat k a b -> Cat k b b -> r
forall (x :: k). Cat k a x -> Cat k x b -> r
go Cat k a b
c (Cat k b x -> Cat k x b -> Cat k b b
forall {k} (k :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Cat k a b -> Cat k b c -> Cat k a c
Tree Cat k b x
d Cat k x b
t)

transKleisli :: (m b -> n b) -> Kleisli m a b -> Kleisli n a b
transKleisli :: forall (m :: * -> *) b (n :: * -> *) a.
(m b -> n b) -> Kleisli m a b -> Kleisli n a b
transKleisli m b -> n b
f = ((Any -> m b) -> Any -> n b) -> Kleisli m a b -> Kleisli n a b
forall a b. a -> b
unsafeCoerce (m b -> n b
f (m b -> n b) -> (Any -> m b) -> Any -> n b
forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude..)
{-# INLINE transKleisli #-}