repo initialized

.gitignore

@@ -0,0 +1,2 @@
+_darcs
+dist

LICENSE

@@ -0,0 +1,30 @@
+Copyright 2011 Edward Kmett
+
+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. Neither the name of the author nor the names of his contributors
+   may 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 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.

Prelude/Extras.hs

@@ -0,0 +1,89 @@
+module Prelude.Extras 
+  ( Eq1(..), Ord1(..)
+  , Eq2(..), Ord2(..)
+  , module Text.Show.Extras
+  , module Text.Read.Extras
+  ) where
+
+import Text.Show.Extras
+import Text.Read.Extras
+
+infixr 4 ==#,  /=#,  <#,  <=#,  >=#,  >#
+infixr 4 ==##, /=##, <##, <=##, >=##, >##
+
+class Eq1 f where
+  (==#) :: Eq a => f a -> f a -> Bool
+  (/=#) :: Eq a => f a -> f a -> Bool
+  a /=# b = not (a ==# b)
+
+instance Eq1 Maybe where
+  Just a  ==# Just b  = a == b
+  Nothing ==# Nothing = True
+  _       ==# _       = False
+
+instance Eq a => Eq1 (Either a) where
+  (==#) = (==)
+
+instance Eq1 [] where
+  (==#) = (==)
+
+class Eq2 f where
+  (==##) :: (Eq a, Eq b) => f a b -> f a b -> Bool
+  (/=##) :: (Eq a, Eq b) => f a b -> f a b -> Bool
+  a /=## b = not (a ==## b)
+
+instance Eq2 Either where
+  (==##) = (==)
+
+class Eq1 f => Ord1 f where 
+  compare1 :: Ord a => f a -> f a -> Ordering
+  (<#), (<=#), (>=#), (>#) :: Ord a => f a -> f a -> Bool
+  max1, min1 :: Ord a => f a -> f a -> f a
+
+  compare1 x y
+    | x ==# y   = EQ
+    | x <=# y   = LT
+    | otherwise = GT
+
+  x <=# y = compare1 x y /= GT
+  x <#  y = compare1 x y == LT
+  x >=# y = compare1 x y /= LT
+  x ># y  = compare1 x y == GT
+
+  max1 x y 
+    | x >=# y   = x
+    | otherwise = y
+  min1 x y
+    | x <#  y   = x
+    | otherwise = y
+
+instance Ord1 Maybe where compare1 = compare
+instance Ord a => Ord1 (Either a) where compare1 = compare
+instance Ord1 [] where compare1 = compare
+
+-- needs Haskell 2011
+-- instance Ord1 Complex where compare1 = compare
+
+class Eq2 f => Ord2 f where 
+  compare2 :: (Ord a, Ord b) => f a b -> f a b -> Ordering
+  (<##), (<=##), (>=##), (>##) :: (Ord a, Ord b) => f a b -> f a b -> Bool
+  max2, min2 :: (Ord a, Ord b) => f a b -> f a b -> f a b
+
+  compare2 x y
+    | x ==## y  = EQ
+    | x <=## y  = LT
+    | otherwise = GT
+
+  x <=## y = compare2 x y /= GT
+  x <##  y = compare2 x y == LT
+  x >=## y = compare2 x y /= LT
+  x >## y  = compare2 x y == GT
+
+  max2 x y 
+    | x >=## y  = x
+    | otherwise = y
+  min2 x y
+    | x <## y   = x
+    | otherwise = y
+
+instance Ord2 Either where compare2 = compare

Setup.lhs

@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain

Text/Read/Extras.hs

@@ -0,0 +1,142 @@
+{-# LANGUAGE CPP #-}
+
+module Text.Read.Extras 
+  ( Read1(..), read1, reads1
+  , Read2(..), read2, reads2
+#ifdef __GLASGOW_HASKELL__
+  , readList1Default     -- :: (Read1 f, Read a) => ReadS [f a]
+  , readListPrec1Default -- :: (Read1 f, Read a) => ReadPrec [f a]
+  , readList2Default     -- :: (Read1 f, Read a) => ReadS [f a]
+  , readListPrec2Default -- :: (Read1 f, Read a) => ReadPrec [f a]
+#endif
+  ) where
+
+import Text.Read
+import qualified Text.ParserCombinators.ReadP as P
+import qualified Text.Read.Lex as L
+
+class Read1 f where
+  readsPrec1    :: Read a => Int -> ReadS (f a)
+  readList1     :: Read a => ReadS [f a]
+
+  readsPrec1 = readPrec_to_S readPrec1
+  readList1  = readPrec_to_S (list readPrec1) 0 
+
+#ifdef __GLASGOW_HASKELL__
+  readPrec1     :: Read a => ReadPrec (f a)
+  readListPrec1 :: Read a => ReadPrec [f a]
+
+  readPrec1     = readS_to_Prec readsPrec1
+  readListPrec1 = readS_to_Prec (\_ -> readList1)
+#endif
+
+read1  :: (Read1 f, Read a) => String -> f a
+read1 s = either error id (readEither1 s)
+
+reads1 :: (Read1 f, Read a) => ReadS (f a)
+reads1 = readsPrec1 minPrec
+
+readEither1 :: (Read1 f, Read a) => String -> Either String (f a)
+readEither1 s =
+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+    [x] -> Right x
+    []  -> Left "Prelude.read: no parse"
+    _   -> Left "Prelude.read: ambiguous parse"
+ where
+  read' =
+    do x <- readPrec1
+       lift P.skipSpaces
+       return x
+
+#ifdef __GLASGOW_HASKELL__
+readList1Default     :: (Read1 f, Read a) => ReadS [f a]
+readList1Default = readPrec_to_S readListPrec1 0
+
+readListPrec1Default :: (Read1 f, Read a) => ReadPrec [f a]
+readListPrec1Default = list readPrec1
+#endif
+
+instance Read1 [] where
+  readsPrec1 = readsPrec
+  readList1 = readList
+
+instance Read1 Maybe where
+  readsPrec1 = readsPrec
+  readList1 = readList
+
+instance Read a => Read1 (Either a) where
+  readsPrec1 = readsPrec
+  readList1 = readList
+
+instance Read a => Read1 ((,) a) where
+  readsPrec1 = readsPrec
+  readList1 = readList
+
+class Read2 f where
+  readsPrec2    :: (Read a, Read b) => Int -> ReadS (f a b)
+  readList2     :: (Read a, Read b) => ReadS [f a b]
+  readsPrec2    = readPrec_to_S readPrec2
+  readList2     = readPrec_to_S (list readPrec2) 0 
+
+#ifdef __GLASGOW_HASKELL__
+  readPrec2     :: (Read a, Read b) => ReadPrec (f a b)
+  readListPrec2 :: (Read a, Read b) => ReadPrec [f a b]
+  readPrec2     = readS_to_Prec readsPrec2
+  readListPrec2 = readS_to_Prec (\_ -> readList2)
+#endif
+
+instance Read2 (,) where
+  readsPrec2 = readsPrec
+  readList2 = readList
+
+instance Read2 Either where
+  readsPrec2 = readsPrec
+  readList2 = readList
+
+read2  :: (Read2 f, Read a, Read b) => String -> f a b
+read2 s = either error id (readEither2 s)
+
+reads2 :: (Read2 f, Read a, Read b) => ReadS (f a b)
+reads2 = readsPrec2 minPrec
+
+readEither2 :: (Read2 f, Read a, Read b) => String -> Either String (f a b)
+readEither2 s =
+  case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
+    [x] -> Right x
+    []  -> Left "Prelude.read: no parse"
+    _   -> Left "Prelude.read: ambiguous parse"
+ where
+  read' =
+    do x <- readPrec2
+       lift P.skipSpaces
+       return x
+
+#ifdef __GLASGOW_HASKELL__
+readList2Default :: (Read2 f, Read a, Read b) => ReadS [f a b]
+readList2Default = readPrec_to_S readListPrec2 0
+
+readListPrec2Default :: (Read2 f, Read a, Read b) => ReadPrec [f a b]
+readListPrec2Default = list readPrec2
+#endif
+
+-- annoying to hav to copy these from Text.Read
+list :: ReadPrec a -> ReadPrec [a]
+-- ^ @(list p)@ parses a list of things parsed by @p@,
+-- using the usual square-bracket syntax.
+list readx =
+  parens
+  ( do L.Punc "[" <- lexP
+       (listRest False +++ listNext)
+  )
+ where
+  listRest started =
+    do L.Punc c <- lexP
+       case c of
+         "]"           -> return []
+         "," | started -> listNext
+         _             -> pfail
+
+  listNext =
+    do x  <- reset readx
+       xs <- listRest True
+       return (x:xs)

Text/Show/Extras.hs

@@ -0,0 +1,41 @@
+module Text.Show.Extras where
+
+class Show1 f where 
+  showsPrec1 :: Show a => Int -> f a -> ShowS
+  show1      :: Show a => f a -> String
+  showList1  :: Show a => [f a] -> ShowS
+  showsPrec1 _ x s = show1 x ++ s
+  show1 x          = shows1 x ""
+  showList1 ls   s = showList__ shows1 ls s
+
+shows1 :: (Show1 f, Show a) => f a -> ShowS
+shows1 = showsPrec1 0
+
+instance Show1 Maybe where showsPrec1 = showsPrec
+instance Show1 [] where showsPrec1 = showsPrec
+instance Show a => Show1 (Either a) where showsPrec1 = showsPrec
+instance Show a => Show1 ((,) a) where showsPrec1 = showsPrec
+
+-- instance Show1 Complex
+
+class Show2 f where 
+  showsPrec2 :: (Show a, Show b) => Int -> f a b -> ShowS
+  show2      :: (Show a, Show b) => f a b -> String
+  showList2  :: (Show a, Show b) => [f a b] -> ShowS
+
+  showsPrec2 _ x s = show2 x ++ s
+  show2 x          = shows2 x ""
+  showList2 ls   s = showList__ shows2 ls s
+
+shows2 :: (Show2 f, Show a, Show b) => f a b -> ShowS
+shows2 = showsPrec2 0
+
+instance Show2 (,)    where showsPrec2 = showsPrec
+instance Show2 Either where showsPrec2 = showsPrec
+
+showList__ :: (a -> ShowS) ->  [a] -> ShowS
+showList__ _     []     s = "[]" ++ s
+showList__ showx (x:xs) s = '[' : showx x (showl xs)
+  where
+    showl []     = ']' : s
+    showl (y:ys) = ',' : showx y (showl ys)

prelude-extras.cabal

@@ -0,0 +1,28 @@
+name:          prelude-extras
+category:      Polymorphism, Combinators
+version:       0.1
+license:       BSD3
+cabal-version: >= 1.2
+license-file:  LICENSE
+author:        Edward A. Kmett
+maintainer:    Edward A. Kmett <ekmett@gmail.com>
+stability:     provisional
+homepage:      http://comonad.com/reader/
+copyright:     Copyright (C) 2011 Edward A. Kmett
+synopsis:      Haskell 98 - higher order versions of Prelude classes 
+description:   Haskell 98 - higher order versions of Prelude classes to ease programming with polymorphic recursion and reduce UndecidableInstances
+build-type:    Simple
+
+library
+  build-depends: 
+    base >= 4 && < 4.4
+
+  extensions: CPP
+
+  ghc-options: -Wall 
+
+  exposed-modules:
+    Prelude.Extras,
+    Text.Show.Extras,
+    Text.Read.Extras
+