1 {-# LANGUAGE GeneralizedNewtypeDeriving #-} 2 module Data.RangeSet.Parse 3 ( showRangeSet 4 , parseRangeSet 5 ) where 6 7 import Control.Applicative (optional) 8 import Data.Maybe (fromMaybe) 9 import qualified Data.RangeSet.List as R 10 import qualified Text.ParserCombinators.ReadP as RP 11 import qualified Text.ParserCombinators.ReadPrec as RP (lift, readPrec_to_P, minPrec) 12 import Text.Read (readMaybe, readPrec) 13 14 newtype RangeList a = RangeList { unRangeList :: [(a,a)] } deriving (Monoid) 15 16 rangeSetList :: R.RSet a -> RangeList a 17 rangeSetList = RangeList . R.toRangeList 18 19 rangeListSet :: (Ord a, Enum a) => RangeList a -> R.RSet a 20 rangeListSet = R.fromRangeList . unRangeList 21 22 instance (Show a, Eq a, Bounded a) => Show (RangeList a) where 23 showsPrec _ = sl . unRangeList where 24 sl [] = id 25 sl [r] = sr r 26 sl (r:l) = sr r . showChar ',' . sl l 27 sr (a,b) 28 | a == b = shows a 29 | otherwise = (if a == minBound then id else shows a) 30 . showChar '-' . 31 (if b == maxBound then id else shows b) 32 33 showRangeSet :: (Show a, Eq a, Bounded a) => R.RSet a -> String 34 showRangeSet = show . rangeSetList 35 36 readP :: Read a => RP.ReadP a 37 readP = RP.readPrec_to_P readPrec RP.minPrec 38 39 instance (Read a, Bounded a) => Read (RangeList a) where 40 readPrec = RP.lift $ RangeList <$> RP.sepBy rr (RP.char ',') where 41 ru = do 42 _ <- RP.char '-' 43 RP.option maxBound readP 44 rr = do 45 l <- optional readP 46 let lb = fromMaybe minBound l 47 ub <- maybe ru (`RP.option` ru) l 48 return (lb, ub) 49 50 parseRangeSet :: (Ord a, Enum a, Bounded a, Read a) => String -> Maybe (R.RSet a) 51 parseRangeSet = fmap rangeListSet . readMaybe