1 -- Copyright (C) 2007 David Roundy
    2 --
    3 -- This program is free software; you can redistribute it and/or modify
    4 -- it under the terms of the GNU General Public License as published by
    5 -- the Free Software Foundation; either version 2, or (at your option)
    6 -- any later version.
    7 --
    8 -- This program is distributed in the hope that it will be useful,
    9 -- but WITHOUT ANY WARRANTY; without even the implied warranty of
   10 -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   11 -- GNU General Public License for more details.
   12 --
   13 -- You should have received a copy of the GNU General Public License
   14 -- along with this program; see the file COPYING.  If not, write to
   15 -- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
   16 -- Boston, MA 02110-1301, USA.
   17 
   18 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
   19 {-# LANGUAGE CPP #-}
   20 -- , MagicHash, GADTs #-}
   21 
   22 #include "gadts.h"
   23 
   24 module Darcs.Sealed ( Sealed(..), seal, unseal, mapSeal,
   25 #ifndef GADT_WITNESSES
   26                       unsafeUnseal, unsafeUnflippedseal, unsafeUnseal2,
   27 #endif
   28                       Sealed2(..), seal2, unseal2, mapSeal2,
   29                       FlippedSeal(..), flipSeal, unsealFlipped, mapFlipped,
   30                       unsealM, liftSM
   31                     ) where
   32 
   33 import GHC.Base ( unsafeCoerce# )
   34 import Darcs.Show
   35 
   36 data Sealed a where
   37     Sealed :: a C(x ) -> Sealed a
   38 
   39 seal :: a C(x ) -> Sealed a
   40 seal = Sealed
   41 
   42 data Sealed2 a where
   43     Sealed2 :: !(a C(x y )) -> Sealed2 a
   44 
   45 seal2 :: a C(x y ) -> Sealed2 a
   46 seal2 = Sealed2
   47 
   48 data FlippedSeal a C(y) where
   49     FlippedSeal :: !(a C(x y)) -> FlippedSeal a C(y)
   50 
   51 flipSeal :: a C(x y) -> FlippedSeal a C(y)
   52 flipSeal = FlippedSeal
   53 
   54 #ifndef GADT_WITNESSES
   55 unsafeUnseal :: Sealed a -> a
   56 unsafeUnseal (Sealed a) = a
   57 
   58 unsafeUnflippedseal :: FlippedSeal a -> a
   59 unsafeUnflippedseal (FlippedSeal a) = a
   60 
   61 unsafeUnseal2 :: Sealed2 a -> a
   62 unsafeUnseal2 (Sealed2 a) = a
   63 #endif
   64 
   65 seriouslyUnsafeUnseal :: Sealed a -> a C(())
   66 seriouslyUnsafeUnseal (Sealed a) = unsafeCoerce# a
   67 
   68 unseal :: (FORALL(x) a C(x ) -> b) -> Sealed a -> b
   69 unseal f x = f (seriouslyUnsafeUnseal x)
   70 
   71 -- laziness property:
   72 -- unseal (const True) undefined == True
   73 
   74 unsealM :: Monad m => m (Sealed a) -> (FORALL(x) a C(x) -> m b) -> m b
   75 unsealM m1 m2 = do sx <- m1
   76                    unseal m2 sx
   77 
   78 liftSM :: Monad m => (FORALL(x) a C(x) -> b) -> m (Sealed a) -> m b
   79 liftSM f m = do sx <- m
   80                 return (unseal f sx)
   81 
   82 mapSeal :: (FORALL(x) a C(x ) -> b C(x )) -> Sealed a -> Sealed b
   83 mapSeal f = unseal (seal . f)
   84 
   85 mapFlipped :: (FORALL(x) a C(x y) -> b C(x z)) -> FlippedSeal a C(y) -> FlippedSeal b C(z)
   86 mapFlipped f (FlippedSeal x) = FlippedSeal (f x)
   87 
   88 seriouslyUnsafeUnseal2 :: Sealed2 a -> a C(() ())
   89 seriouslyUnsafeUnseal2 (Sealed2 a) = unsafeCoerce# a
   90 
   91 unseal2 :: (FORALL(x y) a C(x y ) -> b) -> Sealed2 a -> b
   92 unseal2 f a = f (seriouslyUnsafeUnseal2 a)
   93 
   94 mapSeal2 :: (FORALL(x y) a C(x y ) -> b C(x y )) -> Sealed2 a -> Sealed2 b
   95 mapSeal2 f = unseal2 (seal2 . f)
   96 
   97 unsealFlipped :: (FORALL(x y) a C(x y) -> b) -> FlippedSeal a C(z) -> b
   98 unsealFlipped f (FlippedSeal a) = f a
   99 
  100 instance Show1 a => Show (Sealed a) where
  101     showsPrec d (Sealed x) = showParen (d > app_prec) $ showString "Sealed " . showsPrec1 (app_prec + 1) x
  102 instance Show2 a => Show (Sealed2 a) where
  103     showsPrec d (Sealed2 x) = showParen (d > app_prec) $ showString "Sealed2 " . showsPrec2 (app_prec + 1) x