elevator 0.1.1.1 → 0.1.2

raw patch · 2 files changed

+10/−7 lines, 2 files

Files

• elevator.cabal +1/−1
• src/Control/Elevator.hs +9/−6

@@ -1,5 +1,5 @@ name:                elevator
-version:             0.1.1.1
+version:             0.1.2
 synopsis:            Immediately lifts to a desired level
 description:         This package provides 'elevate' function which composes 'lift'-like transformations automatically.
 homepage:            https://github.com/fumieval/elevator

@@ -42,10 +42,10 @@ 
 class Tower f where
   type Floors f :: List (* -> *)
-  type Floors f = Empty
+  type Floors f = Identity :> Empty
   toLoft :: Union (Floors f) a -> f a
-  default toLoft :: Union Empty a -> f a
-  toLoft = exhaust
+  default toLoft :: Applicative f => Union (Identity :> Empty) a -> f a
+  toLoft = pure . runIdentity ||> exhaust
 
 type Elevate f g = (Tower g, f ∈ Floors1 g)
 
@@ -60,10 +60,13 @@ {-# INLINE[2] elevate #-}
 
 instance Tower IO where
-  type Floors IO = ST RealWorld :> Empty
-  toLoft = stToIO ||> exhaust
+  type Floors IO = ST RealWorld :> Identity :> Empty
+  toLoft = stToIO ||> return . runIdentity ||> exhaust
 
-instance Tower Identity
+instance Tower Identity where
+  type Floors Identity = Empty
+  toLoft = exhaust
+
 instance Tower Maybe
 instance Tower (Either e)
 instance Tower ((->) r)