diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Hiromi ISHII + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Hiromi ISHII nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +unsafely +======== + +Flexible access control for unsafe operations and instances diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/examples/safe-unsafe.hs b/examples/safe-unsafe.hs new file mode 100644 --- /dev/null +++ b/examples/safe-unsafe.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, UndecidableInstances #-} +module Main where +import Data.Constraint.Unsafely +import Data.IORef +import Data.Proxy +import System.IO.Unsafe + +saferUnsafePerformIO :: Unsafely IO => IO a -> a +saferUnsafePerformIO = unsafePerformIO + +global :: Unsafely IO => IORef Int +global = saferUnsafePerformIO $ newIORef 0 + +unsafelyIO :: (Unsafely IO => a) -> a +unsafelyIO = unsafely (Proxy :: Proxy IO) + +main :: IO () +main = do + unsafelyIO $ readIORef global + return () diff --git a/examples/semigroup.hs b/examples/semigroup.hs new file mode 100644 --- /dev/null +++ b/examples/semigroup.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE EmptyDataDecls, FlexibleContexts, FlexibleInstances, RankNTypes #-} +{-# LANGUAGE TypeSynonymInstances, UndecidableInstances #-} +module Main where +import Data.Constraint.Unsafely +import Data.Proxy + +class Semigroup a where + -- | binary operation which satisifies associative law: + -- @(a .+. b) .+. c == a .+. (b .+. c)@ + (.+.) :: a -> a -> a + +infixl 6 .+. + +-- | 'Int', 'Integer' and 'Rational' satisfies associative law. +instance Semigroup Int where + (.+.) = (+) +instance Semigroup Integer where + (.+.) = (+) +instance Semigroup Rational where + (.+.) = (+) + +-- | Dummy type indicating the computation which may /unsafely/ violates associative law. +data ViolateAssocLaw + +-- | Helper function to use /unsafe/ instance for @Semigroup@ +unsafelyViolate :: (Unsafely ViolateAssocLaw => a) -> a +unsafelyViolate = unsafely (Proxy :: Proxy ViolateAssocLaw) + +-- | 'Double' doesn't satsfies associative law: +-- +-- > (1.9546929672907305 + 2.0) + 0.14197132377740074 == 4.096664291068132 +-- > 1.9546929672907305 + (2.0 + 0.14197132377740074) == 4.096664291068131 +-- +-- But sometimes there is the case the instance for @Semigroup@ for Double is required. +-- So we use @Unsafely@ to mark this instance is somewhat unsafe. +instance Unsafely ViolateAssocLaw => Semigroup Double where + (.+.) = (+) + +main :: IO () +main = do + print (1 .+. 2 :: Int) + unsafelyViolate $ print (3 .+. 4 :: Double) + -- You cannot done as above, if you drop @unsafelyViolate@. + -- Uncommenting following line causes type error. + -- print (5 .+. 6 :: Double) + + diff --git a/src/Data/Constraint/Unsafely.hs b/src/Data/Constraint/Unsafely.hs new file mode 100644 --- /dev/null +++ b/src/Data/Constraint/Unsafely.hs @@ -0,0 +1,154 @@ +{-# OPTIONS_GHC -fno-warn-unused-binds #-} +module Data.Constraint.Unsafely ( + -- * Introduction + -- $introduction + + -- * Interface + Unsafely, unsafely, + + -- * Example: semigroup instance + -- $semigroup + + -- ** Allow unsafe operations globally + -- $really + + -- * Example: restrict the access for unsafe operations + -- $restriction +) where +import Data.Constraint.Unsafely.Really + +{- $introduction #introduction# +This module aims at providing simple interface to express some operations or instance are considered to be /unsafe/. + +The motivation of this package is somewhat similar to +@@ extension, +but permits more flexible access control. See <#g:3 example> for more detail. +-} + +{- $semigroup +The first example is about /unsafe/ instances. Below, we use @EmptyDataDecls@, @FlexibleContexts@, @FlexibleInstances@, +@RankNTypes@, @TypeSynonymInstances@ and @UndecidableInstances@ extensions. + +Let's think about semigroups. Semigroups are sets equipped with binary relation, which satisfies assosiative law. i.e: + +> a + (b + c) == (a + b) + c + +We denote this binary operation as @.+.@. + +@ +class Semigroup a where + (.+.) :: a -> a -> a + +infixl 6 .+. +@ + +'Int', 'Integer' and 'Rational's are naturally semigroups with their ordinary addition: + +@ +instance Semigroup Int where + (.+.) = (+) +instance Semigroup Integer where + (.+.) = (+) +instance Semigroup Rational where + (.+.) = (+) +@ + +But, unfortunately, 'Double' is not semigroup because it doesn't satisfies associative law. +For example: + +@ +(1.9546929672907305 + 2.0) + 0.14197132377740074 == 4.096664291068132 +1.9546929672907305 + (2.0 + 0.14197132377740074) == 4.096664291068131 -- different! +@ + +But, in some cases, we need @Semigroup@ instance for 'Double' for convenience. +So we provide @Semigroup Double@ instance with the /unsafety/ precondition: + +@ +data ViolateAssocLaw + +unsafelyViolate :: ('Unsafely' ViolateAssocLaw => a) -> a +unsafelyViolate = 'unsafely' ('Proxy' :: 'Proxy' ViolateAssocLaw) + +instance 'Unsafely' ViolateAssocLaw => Semigroup Double where + (.+.) = (+) +@ + +In above, @ViolateAssocLaw@ is the tag for unsafe @Semigroup@ instance which may violate associative law. +For the convenience, we also defined the convenient function @unsafelyViolate@. + +With the code above, we get the following: + +>>> 1 .+. 2 :: Int +3 +>>> 2 .+. 0.5 :: Rational +5 % 2 +>>> 3.0 .+. 0.4 :: Double + No instance for (Data.Constraint.Unsafely.Really.ReallyUnsafely ViolateAssocLaw) + arising from a use of `.+.' + Possible fix: + add an instance declaration for + (Data.Constraint.Unsafely.Really.ReallyUnsafely ViolateAssocLaw) + In the expression: 1.0 .+. 2.0 :: Double + In an equation for `it': it = 1.0 .+. 2.0 :: Double +>>> unsafelyViolate $ 3.0 .+. 4.0 :: Double +7.0 +-} + +{- $really +Things seems to be good! But, what is the 'ReallyUnsafely' type-class? + +This class prevents users from writing 'Unsafely' instace globaly and contaminating entire program. +This is because 'ReallyUnsafely' is not exported in this module and 'ReallyUnsafely' is the superclass of 'Unsafely'. + +On the other hand, there is the case to permit /unsafe/ operations globally. In such situation, "Data.Constraint.Unsafely.Really" module enables you to write such an instace: + +>>> 3 .+. 4 :: Double +:4:3: + No instance for (ReallyUnsafely * ViolateAssocLaw) + arising from a use of `.+.' + Possible fix: + add an instance declaration for (ReallyUnsafely * ViolateAssocLaw) + In the expression: 3 .+. 4 :: Double + In an equation for `it': it = 3 .+. 4 :: Double +>>> import Data.Constraint.Unsafely.Really +>>> instance ReallyUnsafely ViolateAssocLaw +>>> 3 .+. 4 :: Double +7.0 + +As above, once you declare the 'ReallyUnsafely' instance for your tag, you can use unsafe operations anywhere in your code. +-} + +{- $restriction +Another example is slightly safer 'unsafePerformIO'. +As above, we can provide the following interface: + +@ +module Main where +import Data.Constraint.Unsafely +import Data.IORef +import Data.Proxy +import System.IO.Unsafe + +saferUnsafePerformIO :: Unsafely IO => IO a -> a +saferUnsafePerformIO = unsafePerformIO + +unsafelyIO :: (Unsafely IO => a) -> a +unsafelyIO = unsafely (Proxy :: Proxy IO) +@ + +In this example, we use 'IO' type as the tag of unsafety precondition instead of defining new empty data-type. +'Unsafely' class is kind-polymorphic, so it can take any type of any kind as its parameter. + +With this, we can create the global state, which is inaccessible without @Unsafely IO@. + +@ +global :: Unsafely IO => IORef Int +global = saferUnsafePerformIO $ newIORef 0 + +main :: IO () +main = do + unsafelyIO $ readIORef global + return () +@ +-} diff --git a/src/Data/Constraint/Unsafely/Really.hs b/src/Data/Constraint/Unsafely/Really.hs new file mode 100644 --- /dev/null +++ b/src/Data/Constraint/Unsafely/Really.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE FlexibleContexts, FlexibleInstances, PolyKinds, RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables, UndecidableInstances #-} +-- | Really unsafe module to provide internal interface. +-- This module should be imported if you wish to allow the unsafe computation globally. +-- +-- But be careful: the unsafety contaminates entire the program once you write +-- the instance for 'ReallyUnsafe' somewhere. +module Data.Constraint.Unsafely.Really ( + ReallyUnsafely, Unsafely, unsafely + ) where +import Data.Proxy +import Unsafe.Coerce + +-- | The trick type-class to prevent providing global instances for @Unsafely@. +-- This class is not exported in "Data.Constraint.Unsafely", so if you want to +-- permit unsafe operations globally, you should import this module directly. +class ReallyUnsafely t + +-- | The constraint for the instances which might be /unsafe/ in some sence. +-- @t@ in @Unsafely t@ is the dummy tag for some series of /unsafe/ operations. +class ReallyUnsafely t => Unsafely (t :: k) where + impossible :: Impossible t +instance ReallyUnsafely t => Unsafely t where + impossible = Impossible + +-- | Witness to allow /unsafe/ computation. +-- This type never be exported, which ensures that you can call @unsafely@ safely. +data Impossible (t :: k) = Impossible + +newtype Thingy t a = Thingy (Unsafely t => a) + +-- | Evaluate the value which might be unsafe. +unsafely :: forall t a. Proxy t -> (Unsafely t => a) -> a +unsafely _ f = unsafeCoerce (Thingy f :: Thingy t a) Impossible diff --git a/unsafely.cabal b/unsafely.cabal new file mode 100644 --- /dev/null +++ b/unsafely.cabal @@ -0,0 +1,54 @@ +name: unsafely +version: 0.1.0.0 +synopsis: Flexible access control for unsafe operations and instances +description: This module aims at providing simple interface to control the acccess for /unsafe/ + operations and instance. + + The motivation of this package is somewhat similar to + @@ extension, + but permits more flexible access control. + +homepage: http://github.com/konn/unsafely +license: BSD3 +license-file: LICENSE +author: Hiromi ISHII +maintainer: konn.jinro_at_gmail.com +copyright: 2014 (c) Hiromi ISHII +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +flag examples + default: False + +source-repository head + type: git + location: git://github.com/ekmett/lens.git + +library + exposed-modules: Data.Constraint.Unsafely, Data.Constraint.Unsafely.Really + other-extensions: FlexibleContexts, FlexibleInstances, RankNTypes, ScopedTypeVariables, UndecidableInstances + build-depends: base >=4.6 && <4.7, tagged >=0.6 && <0.7 + hs-source-dirs: src + default-language: Haskell2010 + +executable semigroup + if flag(examples) + buildable: True + else + buildable: False + build-depends: base >=4.6 && <4.7, tagged >=0.6 && <0.7, unsafely + hs-source-dirs: examples + main-is: semigroup.hs + default-language: Haskell2010 + +executable safe-unsafe + if flag(examples) + buildable: True + else + buildable: False + build-depends: base >=4.6 && <4.7, tagged >=0.6 && <0.7, unsafely + hs-source-dirs: examples + main-is: safe-unsafe.hs + default-language: Haskell2010