{-# LANGUAGE MultiParamTypeClasses #-}
module Util.NumberRange (NumberRange, range) where
import Control.Monad (forM)
import Data.Semigroup
import Util.String (split)
import Util.List (groupBy')
import Data.List (sort, nub, intercalate)
import Database.HDBC (SqlValue, fromSql, toSql)
import Data.Convertible.Base (Convertible, safeConvert, convError)
import Ideas.Utils.Prelude (readM)
newtype NumberRange = NumberRange [Int]
range :: [Int] -> NumberRange
range = NumberRange . nub
instance Semigroup NumberRange where
(NumberRange r1) <> (NumberRange r2) = NumberRange . nub $ r1 ++ r2
instance Monoid NumberRange where
mempty = NumberRange []
mappend = (<>)
instance Show NumberRange where
show (NumberRange range)
= intercalate ","
. map f
. groupBy' (\x y -> abs (x - y) == 1)
. sort
$ range
where
f [] = show ""
f [x] = show x
f xs = show (head xs) ++ "-" ++ show (last xs)
instance Convertible NumberRange SqlValue where
safeConvert = Right . toSql . show
instance Convertible SqlValue NumberRange where
safeConvert sql = either (flip convError sql) Right $ do
let string = fromSql sql
ranges <- forM (split ',' string) $ \range ->
case split '-' range of
[i] -> do
i' <- readM i
return [i']
[i,j] -> do
i' <- readM i
j' <- readM j
return [i'..j']
_ -> fail "number range could not be parsed"
return . NumberRange . concat $ ranges