compare-type (empty) → 0.1

raw patch · 4 files changed

+188/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

LICENSE +28/−0
Setup.hs +2/−0
compare-type.cabal +38/−0
src/Type/Compare.hs +120/−0

+ LICENSE view

@@ -0,0 +1,28 @@+Copyright (c) 2015, Yusuke Matsushita+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 compare-type nor the names of its+  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 HOLDER 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.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ compare-type.cabal view

@@ -0,0 +1,38 @@+name: compare-type
+category: Dependent Types
+version: 0.1
+license: BSD3
+license-file: LICENSE
+cabal-version: >= 1.10
+tested-with: GHC==7.8.3
+author: Yusuke Matsushita
+maintainer: Yusuke Matsushita <y.skm24t@gmail.com>
+stability: provisional
+homepage: https://github.com/Kinokkory/compare-type
+bug-reports: https://github.com/Kinokkory/compare-type/issues
+copyright: (c) Yusuke Matsushita 2014
+synopsis: compare types of any kinds in haskell
+description:
+    Compare types of any kinds in Haskell.
+    .
+    More information can be found in the <http://hackage.haskell.org/package/compare-type hackage's haddock> or the <http://kinokkory.github.io/compare-type/ updated haddock>.
+
+build-type: Simple
+
+source-repository head
+    type: git
+    location: git@github.com:Kinokkory/compare-type.git
+
+library
+    hs-source-dirs: src
+    default-language: Haskell2010
+    other-extensions:
+        Safe, Trustworthy,
+        TypeOperators,
+        PolyKinds, DataKinds,
+        TypeFamilies,
+        UndecidableInstances
+    build-depends:
+        base ==4.*
+    exposed-modules: Type.Compare
+    ghc-options: -Wall

+ src/Type/Compare.hs view

@@ -0,0 +1,120 @@+{-# LANGUAGE Trustworthy,
+    TypeOperators,
+    PolyKinds, DataKinds,
+    TypeFamilies,
+    UndecidableInstances #-}
+
+module Type.Compare (
+    -- * Comparison
+    Compare, LargestK(Largest), SmallestK(Smallest), CompareUser,
+    OrdCase, CompareCase, type (<!), type (>=!), type (>!), type (<=!), Max, Min
+  ) where
+
+import Data.Ord
+import GHC.TypeLits
+
+type family (a :: Ordering) $$ (b :: Ordering) :: Ordering where
+  LT $$ b = LT
+  GT $$ b = GT
+  EQ $$ b = b
+infixl 0 $$
+
+-- | The largest type (and kind) on 'Compare'.
+data LargestK = Largest
+-- | The smallest type (and kind) on 'Compare'.
+data SmallestK = Smallest
+
+-- | Compare two types.
+type family Compare (a :: k) (b :: k') :: Ordering where
+  Compare Largest Largest = EQ
+  Compare _' Largest = LT
+  Compare Largest _' = GT
+  Compare Smallest Smallest = EQ
+  Compare _' Smallest = GT
+  Compare Smallest _' = LT
+
+  Compare (Down a) (Down b) = Compare b a
+
+  Compare False False = EQ
+  Compare False True = LT
+  Compare True False = GT
+  Compare True True = EQ
+
+  Compare LT LT = EQ
+  Compare LT EQ = LT
+  Compare LT GT = LT
+  Compare EQ LT = GT
+  Compare EQ EQ = EQ
+  Compare EQ GT = LT
+  Compare GT LT = GT
+  Compare GT EQ = GT
+  Compare GT GT = EQ
+
+  Compare m n = CmpNat m n
+
+  Compare s t = CmpSymbol s t
+
+  Compare Nothing Nothing = EQ
+  Compare Nothing (Just b) = LT
+  Compare (Just a) Nothing = GT
+  Compare (Just a) (Just b) = Compare a b
+
+  Compare (Left _') (Right _'') = LT
+  Compare (Right _') (Left _'') = GT
+  Compare (Left a) (Left b) = Compare a b
+  Compare (Right a) (Right b) = Compare a b
+
+  Compare '[] '[] = EQ
+  Compare '[] (b ': bs) = LT
+  Compare (a ': as) '[] = GT
+  Compare (a ': as) (b ': bs) = Compare a b $$ Compare as bs
+
+  Compare '() '() = EQ
+  Compare '(a1, a2) '(b1, b2) = Compare a1 b1 $$ Compare a2 b2
+  Compare '(a1, a2, a3) '(b1, b2, b3) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3
+  Compare '(a1, a2, a3, a4) '(b1, b2, b3, b4) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4
+  Compare '(a1, a2, a3, a4, a5) '(b1, b2, b3, b4, b5) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5
+  Compare '(a1, a2, a3, a4, a5, a6) '(b1, b2, b3, b4, b5, b6) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6
+  Compare '(a1, a2, a3, a4, a5, a6, a7) '(b1, b2, b3, b4, b5, b6, b7) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7
+  Compare '(a1, a2, a3, a4, a5, a6, a7, a8) '(b1, b2, b3, b4, b5, b6, b7, b8) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8
+  Compare '(a1, a2, a3, a4, a5, a6, a7, a8, a9) '(b1, b2, b3, b4, b5, b6, b7, b8, b9) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8 $$ Compare a9 b9
+  Compare '(a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) '(b1, b2, b3, b4, b5, b6, b7, b8, b9, b10) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8 $$ Compare a9 b9 $$ Compare a10 b10
+
+  Compare () () = EQ
+  Compare (a1, a2) (b1, b2) = Compare a1 b1 $$ Compare a2 b2
+  Compare (a1, a2, a3) (b1, b2, b3) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3
+  Compare (a1, a2, a3, a4) (b1, b2, b3, b4) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4
+  Compare (a1, a2, a3, a4, a5) (b1, b2, b3, b4, b5) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5
+  Compare (a1, a2, a3, a4, a5, a6) (b1, b2, b3, b4, b5, b6) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6
+  Compare (a1, a2, a3, a4, a5, a6, a7) (b1, b2, b3, b4, b5, b6, b7) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7
+  Compare (a1, a2, a3, a4, a5, a6, a7, a8) (b1, b2, b3, b4, b5, b6, b7, b8) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8
+  Compare (a1, a2, a3, a4, a5, a6, a7, a8, a9) (b1, b2, b3, b4, b5, b6, b7, b8, b9) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8 $$ Compare a9 b9
+  Compare (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10) (b1, b2, b3, b4, b5, b6, b7, b8, b9, b10) = Compare a1 b1 $$ Compare a2 b2 $$ Compare a3 b3 $$ Compare a4 b4 $$ Compare a5 b5 $$ Compare a6 b6 $$ Compare a7 b7 $$ Compare a8 b8 $$ Compare a9 b9 $$ Compare a10 b10
+
+  Compare a b = CompareUser a b
+
+-- | Compare two types. Users can add instances.
+type family CompareUser (a :: k) (b :: k') :: Ordering
+
+type family OrdCase (o :: Ordering) (x :: l1) (y :: l2) (z :: l3) :: l where
+  OrdCase LT x _' _'' = x
+  OrdCase EQ _' y _'' = y
+  OrdCase GT _' _'' z = z
+
+type family CompareCase (a :: k) (b :: k') (x :: l1) (y :: l2) (z :: l3) :: l where
+  CompareCase a b x y z = OrdCase (Compare a b) x y z
+
+type family (a :: k) <! (b :: k') :: Bool where
+  a <! b = CompareCase a b True False False
+type family (a :: k) >=! (b :: k') :: Bool where
+  a >=! b = CompareCase a b False True True
+type family (a :: k) >! (b :: k') :: Bool where
+  a >! b = CompareCase a b False False True
+type family (a :: k) <=! (b :: k') :: Bool where
+  a <=! b = CompareCase a b True True False
+infixl 4 <!, >=!, >!, <=!
+
+type family Max (a :: k1) (b :: k2) :: k where
+  Max a b = CompareCase a b b b a
+type family Min (a :: k1) (b :: k2) :: k where
+  Min a b = CompareCase a b a a b