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