← Back to branch summary

~ubuntu-branches/ubuntu/wily/haskell-stringprep/wily

« back to all changes in this revision

Viewing changes to tests/Ranges.hs

  • Committer: Package Import Robot
  • Author(s): Colin Watson
  • Date: 2015-06-04 10:33:11 UTC
  • mfrom: (3.1.3 wily-proposed)
  • Revision ID: package-import@ubuntu.com-20150604103311-g18t1sqyfx1dhxbj
Tags: 1.0.0-2build2
Rebuild for new GHC ABIs.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tests/Ranges.hs
 
1
module Ranges
 
2
where
 
3
 
 
4
import Data.Set (Set)
 
5
import qualified Data.Set as Set
 
6
 
 
7
data Ord a => Range a = Single !a | Range !a !a
 
8
instance (Ord a, Show a) => Show (Range a) where
 
9
        show (Single x) = concat ["(", show x, ")"]
 
10
        show (Range x y) = concat ["(", show x, "–", show y, ")"]
 
11
 
 
12
newtype Ord a => Ranges a = Ranges [Range a] deriving Show
 
13
 
 
14
-- | A rather hacked-up instance.
 
15
-- This is to support fast lookups using 'Data.Set' (see 'toSet').
 
16
instance (Ord a) => Eq (Range a) where
 
17
        (Single x) == (Single y) = x == y
 
18
        (Single a) == (Range x y) = x <= a && a <= y
 
19
        (Range x y) == (Single a) = x <= a && a <= y
 
20
        (Range lx ux) == (Range ly uy) = (lx <= uy && ux >= ly) || (ly <= ux && uy >= lx)
 
21
 
 
22
instance (Ord a) => Ord (Range a) where
 
23
        (Single x) <= (Single y) = x <= y
 
24
        (Single x) <= (Range y _) = x <= y
 
25
        (Range _ x) <= (Single y) = x <= y
 
26
        (Range _ x) <= (Range y _) = x <= y
 
27
 
 
28
-- | A range consisting of a single value.
 
29
single :: (Ord a) => a -> Range a
 
30
single x = Single x
 
31
 
 
32
-- | Construct a 'Range' from a lower and upper bound.
 
33
range :: (Ord a) => a -> a -> Range a
 
34
range l u
 
35
        | l <= u = Range l u
 
36
        | otherwise = error "lower bound must be smaller than upper bound"
 
37
 
 
38
-- | Construct a 'Ranges' from a list of lower and upper bounds.
 
39
ranges :: (Ord a) => [Range a] -> Ranges a
 
40
ranges = Ranges . foldr (flip mergeRanges) []
 
41
 
 
42
-- | Tests if a given range contains a particular value.
 
43
inRange :: (Ord a) => a -> Range a -> Bool
 
44
inRange x y = Single x == y
 
45
 
 
46
-- | Tests if any of the ranges contains a particular value.
 
47
inRanges :: (Ord a) => a -> Ranges a -> Bool
 
48
inRanges x (Ranges xs) = or . map (x `inRange`) $ xs
 
49
 
 
50
mergeRange :: (Ord a) => Range a -> Range a -> Either (Range a) (Range a)
 
51
mergeRange x y =
 
52
        if x == y
 
53
                then Right $ minMax x y
 
54
                else Left $ x
 
55
 
 
56
minMax :: (Ord a) => Range a -> Range a -> Range a
 
57
minMax (Range lx ux) (Range ly uy) = Range (min lx ly) (max ux uy)
 
58
minMax (Single _) y = y
 
59
minMax x@(Range _ _) (Single _) = x
 
60
 
 
61
-- | Allows quick lookups using ranges.
 
62
toSet :: (Ord a) => Ranges a -> Set (Range a)
 
63
toSet (Ranges x) = Set.fromList x
 
64
 
 
65
addRange :: (Ord a) => Ranges a -> Range a -> Ranges a
 
66
addRange (Ranges x) = Ranges . mergeRanges x
 
67
 
 
68
mergeRanges :: (Ord a) => [Range a] -> Range a -> [Range a]
 
69
mergeRanges [] y = [y]
 
70
mergeRanges (x:xs) y = case mergeRange x y of
 
71
                Right z -> mergeRanges xs z
 
72
                Left x -> x : (mergeRanges xs y)