Boolean-0.2.4/0000755000000000000000000000000013052413262011260 5ustar0000000000000000Boolean-0.2.4/Boolean.cabal0000644000000000000000000000226013052413262013623 0ustar0000000000000000Name: Boolean Version: 0.2.4 Synopsis: Generalized booleans and numbers Category: Data Cabal-Version: >= 1.6 Description: Some classes for generalized boolean operations. Starting with 0.1.0, this package uses type families. Up to version 0.0.2, it used MPTCs with functional dependencies. My thanks to Andy Gill for suggesting & helping with the change. Thanks also to Alex Horsman for Data.Boolean.Overload and to Jan Bracker for Data.Boolean.Numbers. . Copyright 2009-2013 Conal Elliott; BSD3 license. Author: Conal Elliott Maintainer: conal@conal.net Copyright: (c) 2009-2013 by Conal Elliott License: BSD3 License-File: COPYING Stability: experimental build-type: Simple source-repository head type: git location: git://github.com/conal/Boolean.git Library hs-Source-Dirs: src Extensions: Build-Depends: base<5 Exposed-Modules: Data.Boolean Data.Boolean.Overload Data.Boolean.Numbers ghc-options: -Wall -- ghc-prof-options: -prof -auto-all Boolean-0.2.4/COPYING0000644000000000000000000000257213052413262012321 0ustar0000000000000000Copyright (c) 2009-2012 Conal Elliott All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. The names of the authors may not be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. Boolean-0.2.4/Setup.lhs0000644000000000000000000000011413052413262013064 0ustar0000000000000000#!/usr/bin/env runhaskell > import Distribution.Simple > main = defaultMain Boolean-0.2.4/src/0000755000000000000000000000000013052413262012047 5ustar0000000000000000Boolean-0.2.4/src/Data/0000755000000000000000000000000013052413262012720 5ustar0000000000000000Boolean-0.2.4/src/Data/Boolean.hs0000644000000000000000000001644313052413262014643 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, UndecidableInstances, ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies, FlexibleContexts, CPP #-} {-# OPTIONS_GHC -Wall #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TEMP {-# OPTIONS_GHC -fno-warn-unused-binds #-} -- TEMP ---------------------------------------------------------------------- -- | -- Module : Data.Boolean -- Copyright : (c) Conal Elliott 2009-2012 -- License : BSD3 -- -- Maintainer : conal@conal.net -- Stability : experimental -- -- Some classes for generalized boolean operations. -- -- In this design, for if-then-else, equality and inequality tests, the -- boolean type depends on the value type. -- -- I also tried using a unary type constructor class. The class doesn't work -- for regular booleans, so generality is lost. Also, we'd probably have -- to wire class constraints in like: @(==*) :: Eq a => f Bool -> f a -> f -- a -> f a@, which disallows situations needing additional constraints, -- e.g., Show. -- -- Starting with 0.1.0, this package uses type families. -- Up to version 0.0.2, it used MPTCs with functional dependencies. -- My thanks to Andy Gill for suggesting & helping with the change. ---------------------------------------------------------------------- module Data.Boolean ( Boolean(..), BooleanOf, IfB(..) , boolean, cond, crop , EqB(..), OrdB(..) , minB, maxB, sort2B , guardedB, caseB ) where #if MIN_VERSION_base(4,8,0) import Prelude hiding ((<*)) #endif import Data.Monoid (Monoid,mempty) import Control.Applicative (Applicative(pure),liftA2,liftA3) {-------------------------------------------------------------------- Classes --------------------------------------------------------------------} infixr 3 &&* infixr 2 ||* -- | Generalized boolean class class Boolean b where true, false :: b notB :: b -> b (&&*), (||*) :: b -> b -> b instance Boolean Bool where true = True false = False notB = not (&&*) = (&&) (||*) = (||) -- | 'BooleanOf' computed the boolean analog of a specific type. type family BooleanOf a -- | Types with conditionals class Boolean (BooleanOf a) => IfB a where ifB :: (bool ~ BooleanOf a) => bool -> a -> a -> a -- | Expression-lifted conditional with condition last boolean :: (IfB a, bool ~ BooleanOf a) => a -> a -> bool -> a boolean t e bool = ifB bool t e -- | Point-wise conditional cond :: (Applicative f, IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a -> f a cond = liftA3 ifB -- | Generalized cropping, filling in 'mempty' where the test yields false. crop :: (Applicative f, Monoid (f a), IfB a, bool ~ BooleanOf a) => f bool -> f a -> f a crop r f = cond r f mempty -- | A generalized replacement for guards and chained ifs. guardedB :: (IfB b, bool ~ BooleanOf b) => bool -> [(bool,b)] -> b -> b guardedB _ [] e = e guardedB a ((c,b):l) e = ifB c b (guardedB a l e) -- | A generalized version of a case like control structure. caseB :: (IfB b, bool ~ BooleanOf b) => a -> [(a -> bool, b)] -> b -> b caseB _ [] e = e caseB x ((p,b):l) e = ifB (p x) b (caseB x l e) infix 4 ==*, /=* -- | Types with equality. Minimum definition: '(==*)'. class Boolean (BooleanOf a) => EqB a where (==*), (/=*) :: (bool ~ BooleanOf a) => a -> a -> bool u /=* v = notB (u ==* v) infix 4 <*, <=*, >=*, >* -- | Types with inequality. Minimum definition: '(<*)'. class Boolean (BooleanOf a) => OrdB a where (<*), (<=*), (>*), (>=*) :: (bool ~ BooleanOf a) => a -> a -> bool u >* v = v <* u u >=* v = notB (u <* v) u <=* v = v >=* u -- | Variant of 'min' using 'ifB' and '(<=*)' minB :: (IfB a, OrdB a) => a -> a -> a u `minB` v = ifB (u <=* v) u v -- | Variant of 'max' using 'ifB' and '(>=*)' maxB :: (IfB a, OrdB a) => a -> a -> a u `maxB` v = ifB (u >=* v) u v -- | Variant of 'min' and 'max' using 'ifB' and '(<=*)' sort2B :: (IfB a, OrdB a) => (a,a) -> (a,a) sort2B (u,v) = ifB (u <=* v) (u,v) (v,u) {-------------------------------------------------------------------- Instances for Prelude types --------------------------------------------------------------------} -- Simple if-then-else as function. ife :: Bool -> a -> a -> a ife c t e = if c then t else e -- I'd give the following instances: -- -- instance IfB a where ifB = ife -- instance Eq a => EqB a where { (==*) = (==) ; (/=*) = (/=) } -- instance Ord a => Ord a where { (<*) = (<) ; (<=*) = (<=)} -- -- Sadly, doing so would break the a->bool fundep, which is needed elsewhere -- for disambiguation. So use the instances above as templates, filling -- in specific types for a. #define SimpleInstances(Ty) \ instance IfB (Ty) where { ifB = ife } ;\ instance EqB (Ty) where { (==*) = (==) ; (/=*) = (/=) } ;\ instance OrdB (Ty) where { (<*) = (<) ; (<=*) = (<=) } #define SimpleTy(Ty) \ type instance BooleanOf (Ty) = Bool ;\ SimpleInstances(Ty) SimpleTy(Int) SimpleTy(Integer) SimpleTy(Float) SimpleTy(Double) SimpleTy(Bool) SimpleTy(Char) -- Similarly for other simple types. -- TODO: Export these macros for external use. I guess I'd want a .h file as in -- the applicative-numbers package. type instance BooleanOf [a] = BooleanOf a type instance BooleanOf (a,b) = BooleanOf a type instance BooleanOf (a,b,c) = BooleanOf a type instance BooleanOf (a,b,c,d) = BooleanOf a type instance BooleanOf (z -> a) = z -> BooleanOf a -- I'm uncomfortable with this list instance. It's unlike tuples and unlike -- functions. It could be generalized from BooleanOf a ~ Bool to a general case -- for applicatives, but then the list version would form cross products. -- Consider strings and other list types under a variety of use scenarios. instance (Boolean (BooleanOf a),BooleanOf a ~ Bool) => IfB [a] where { ifB = ife } instance (bool ~ BooleanOf p, bool ~ BooleanOf q ,IfB p, IfB q) => IfB (p,q) where ifB w (p,q) (p',q') = (ifB w p p', ifB w q q') instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r ,IfB p, IfB q, IfB r) => IfB (p,q,r) where ifB w (p,q,r) (p',q',r') = (ifB w p p', ifB w q q', ifB w r r') instance (bool ~ BooleanOf p, bool ~ BooleanOf q, bool ~ BooleanOf r, bool ~ BooleanOf s ,IfB p, IfB q, IfB r, IfB s) => IfB (p,q,r,s) where ifB w (p,q,r,s) (p',q',r',s') = (ifB w p p', ifB w q q', ifB w r r', ifB w s s') -- Instances for functions, using the standard pattern for applicative functions. -- Note that the [] applicative does not use this instance. Fishy. instance Boolean bool => Boolean (z -> bool) where true = pure true false = pure false notB = fmap notB (&&*) = liftA2 (&&*) (||*) = liftA2 (||*) instance IfB a => IfB (z -> a) where ifB = cond instance EqB a => EqB (z -> a) where { (==*) = liftA2 (==*) ; (/=*) = liftA2 (/=*) } instance OrdB a => OrdB (z -> a) where { (<*) = liftA2 (<*) ; (<=*) = liftA2 (<=*) } -- TODO: Generalize the function instance into a macro for arbitrary -- applicatives. Instantiate for functions. {- {-------------------------------------------------------------------- Tests --------------------------------------------------------------------} t1 :: String t1 = ifB True "foo" "bar" t2 :: Float -> Float t2 = ifB (< 0) negate id -- No instance for (IfB (a -> Bool) (a1 -> a1)) -- arising from a use of `ifB' -- -- t2 = ifB (< 0) negate id -- abs -} Boolean-0.2.4/src/Data/Boolean/0000755000000000000000000000000013052413262014277 5ustar0000000000000000Boolean-0.2.4/src/Data/Boolean/Numbers.hs0000644000000000000000000001672213052413262016256 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -Wall #-} ------------------------------------------------------------------------- -- | -- Module : Data.Boolean.Numbers -- Copyright : (c) Jan Bracker 2013 -- License : BSD3 -- -- Maintainer : jbra@informatik.uni-kiel.de -- Stability : experimental -- -- A generalized version of the class hirarchy for numbers. All -- functions that would break a potential deep embedding are removed -- or generalized to support deep embeddings. -- -- The class hierarchy for numeric types keeps as close as possible to the -- 'Prelude' hierarchy. A great part of the default implementation and comments -- are copied and adopted from 'Prelude'. -- ------------------------------------------------------------------------- module Data.Boolean.Numbers ( NumB(..) , IntegralB(..) , RealFracB(..) , RealFloatB(..) , evenB, oddB , fromIntegralB ) where import Prelude hiding ( quotRem, divMod , quot, rem , div, mod , properFraction , fromInteger, toInteger ) import qualified Prelude as P import Control.Arrow (first) import Data.Boolean {-------------------------------------------------------------------- Misc --------------------------------------------------------------------} infixr 9 .: -- Double composition. (Aka "result.result". See semantic editor combinators.) (.:) :: (c -> c') -> (a -> b -> c) -> (a -> b -> c') (.:) = (.).(.) (##) :: (a -> b -> c) -> (a -> b -> d) -> a -> b -> (c,d) (f ## g) x y = (f x y, g x y) -- ----------------------------------------------------------------------- -- Generalized Number Class Hirarchy -- ----------------------------------------------------------------------- -- | An extension of 'Num' that supplies the integer type of a -- given number type and a way to create that number from the -- integer. class Num a => NumB a where -- | The accociated integer type of the number. type IntegerOf a -- | Construct the number from the associated integer. fromIntegerB :: IntegerOf a -> a -- | A deep embedded version of 'Integral'. -- Integral numbers, supporting integer division. -- -- Minimal complete definition is either 'quotRem' and 'divMod' -- or the other four functions. Besides that 'toIntegerB' always -- has to be implemented. class (NumB a, OrdB a) => IntegralB a where -- | Integer division truncated towards zero. quot :: a -> a -> a quot = fst .: quotRem -- | Integer reminder, satisfying: -- @(x `quot` y) * y + (x `rem` y) == x@ rem :: a -> a -> a rem = snd .: quotRem -- | Integer division truncated toward negative infinity. div :: a -> a -> a div = fst .: divMod -- | Integer modulus, satisfying: -- @(x `div` y) * y + (x `mod` y) == x@ mod :: a -> a -> a mod = snd .: divMod -- | Simultaneous 'quot' and 'rem'. quotRem :: a -> a -> (a,a) quotRem = quot ## rem -- | Simultaneous 'div' and 'mod'. divMod :: a -> a -> (a,a) divMod = div ## mod -- | Create a integer from this integral. toIntegerB :: a -> IntegerOf a -- | Deep embedded version of 'RealFloat'. -- Extracting components of fractions. -- -- Minimal complete definition: 'properFraction', -- 'round', 'floor' and 'ceiling'. class (NumB a, OrdB a, Fractional a) => RealFracB a where -- | The function 'properFraction' takes a real fractional number @x@ -- and returns a pair @(n,f)@ such that @x = n+f@, and: -- -- * @n@ is an integral number with the same sign as @x@; and -- -- * @f@ is a fraction with the same type and sign as @x@, -- and with absolute value less than @1@. -- -- The default definitions of the 'ceiling', 'floor', 'truncate' -- and 'round' functions are in terms of 'properFraction'. properFraction :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> (b, a) -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@ truncate :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b truncate = fst . properFraction -- | @'round' x@ returns the nearest integer to @x@; -- the even integer if @x@ is equidistant between two integers round :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b -- | @'ceiling' x@ returns the least integer not less than @x@ ceiling :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b -- | @'floor' x@ returns the greatest integer not greater than @x@. floor :: (IntegerOf a ~ IntegerOf b, IntegralB b) => a -> b -- | Deep embedded version of 'RealFloat'. -- Efficient, machine-independent access to the components of a -- floating-point number. -- -- A complete definition has to define all functions. class (Boolean (BooleanOf a), RealFracB a, Floating a) => RealFloatB a where -- | 'true' if the argument is an IEEE \"not-a-number\" (NaN) value. isNaN :: a -> BooleanOf a -- | 'true' if the argument is an IEEE infinity or negative infinity. isInfinite :: a -> BooleanOf a -- | 'true' if the argument is an IEEE negative zero. isNegativeZero :: a -> BooleanOf a -- | 'true' if the argument is an IEEE floating point number. isIEEE :: a -> BooleanOf a -- | a version of arctangent taking two real floating-point arguments. -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle -- (from the positive x-axis) of the vector from the origin to the -- point @(x,y)@. @'atan2' y x@ returns a value in the range [@-pi@, -- @pi@]. It follows the Common Lisp semantics for the origin when -- signed zeroes are supported. @'atan2' y 1@, with @y@ in a type -- that is 'RealFloatB', should return the same value as @'atan' y@. atan2 :: a -> a -> a -- ----------------------------------------------------------------------- -- Generalized Number Utility Functions -- ----------------------------------------------------------------------- -- | Variant of 'even' for generalized booleans. evenB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a evenB n = n `rem` 2 ==* 0 -- | Variant of 'odd' for generalized booleans. oddB :: (IfB a, EqB a, IntegralB a) => a -> BooleanOf a oddB = notB . evenB -- | Variant of 'fromIntegral' for generalized booleans. fromIntegralB :: (IntegerOf a ~ IntegerOf b, IntegralB a, NumB b) => a -> b fromIntegralB = fromIntegerB . toIntegerB -- ----------------------------------------------------------------------- -- Default Class Instances for Basic Types -- ----------------------------------------------------------------------- -- | Only for internal use. fromInteger' :: (Integer ~ IntegerOf b, NumB b) => Integer -> b fromInteger' = fromIntegralB #define DefaultNumBInstance(Ty) \ instance NumB (Ty) where {\ type IntegerOf (Ty) = Integer ;\ fromIntegerB = P.fromInteger } #define DefaultIntegralBInstance(Ty) \ instance IntegralB (Ty) where {\ quotRem = P.quotRem ;\ divMod = P.divMod ;\ toIntegerB = P.toInteger } #define DefaultRealFracFloatBInstance(Ty) \ instance RealFracB (Ty) where {\ properFraction = first fromInteger' . P.properFraction ;\ round = fromInteger' . P.round ;\ floor = fromInteger' . P.floor ;\ ceiling = fromInteger' . P.ceiling };\ instance RealFloatB (Ty) where {\ isNaN = P.isNaN ;\ isInfinite = P.isInfinite ;\ isNegativeZero = P.isNegativeZero ;\ isIEEE = P.isIEEE ;\ atan2 = P.atan2 } DefaultNumBInstance(Int) DefaultNumBInstance(Integer) DefaultNumBInstance(Float) DefaultNumBInstance(Double) DefaultIntegralBInstance(Int) DefaultIntegralBInstance(Integer) DefaultRealFracFloatBInstance(Float) DefaultRealFracFloatBInstance(Double) Boolean-0.2.4/src/Data/Boolean/Overload.hs0000644000000000000000000000320513052413262016406 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} ---------------------------------------------------------------------- -- | -- Module : Data.Boolean.Overload -- License : BSD3 -- -- Author : Alex Horsman (aninhumer) -- Maintainer : conal@conal.net -- Stability : experimental -- -- -- Definitions of Prelude function names in terms of their corresponding -- Data.Boolean generalised implementation. This can then be used as part -- of a partial or complete Prelude replacement. -- -- Also exports ifThenElse for use with RebindableSyntax. ---------------------------------------------------------------------- module Data.Boolean.Overload ( module Data.Boolean, (&&), (||), not, ifThenElse, (==), (/=), (<), (>), (<=), (>=), min, max ) where import Data.Boolean import Prelude hiding ( (&&), (||), not, (==), (/=), (<), (>), (<=), (>=), min, max #if MIN_VERSION_base(4,8,0) , (<*) #endif ) infix 4 ==, /=, <, <=, >=, > infixr 3 && infixr 2 || (&&) :: Boolean a => a -> a -> a (&&) = (&&*) (||) :: Boolean a => a -> a -> a (||) = (||*) not :: Boolean a => a -> a not = notB -- For use with RebindableSyntax ifThenElse :: IfB a => BooleanOf a -> a -> a -> a ifThenElse = ifB (==) :: EqB a => a -> a -> BooleanOf a (==) = (==*) (/=) :: EqB a => a -> a -> BooleanOf a (/=) = (/=*) (<) :: OrdB a => a -> a -> BooleanOf a (<) = (<*) (>) :: OrdB a => a -> a -> BooleanOf a (>) = (>*) (<=) :: OrdB a => a -> a -> BooleanOf a (<=) = (<=*) (>=) :: OrdB a => a -> a -> BooleanOf a (>=) = (>=*) min :: (IfB a, OrdB a) => a -> a -> a min = minB max :: (IfB a, OrdB a) => a -> a -> a max = maxB