1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Controller.IdSet 3 ( IdSet 4 , idSetIsFull 5 , requestIdSet 6 , idSetQuery 7 ) where 8 9 import qualified Data.ByteString.Char8 as BSC 10 import Data.List (foldl') 11 import Data.Maybe (mapMaybe) 12 import qualified Data.RangeSet.List as RS 13 import qualified Data.RangeSet.Parse as RS 14 import Network.HTTP.Types (Query) 15 import qualified Network.Wai as Wai 16 17 import Databrary.Model.Id.Types 18 19 type IdSet a = RS.RSet (Id a) 20 21 idSetIsFull :: (Eq (IdType a), Bounded (IdType a)) => IdSet a -> Bool 22 idSetIsFull = (==) RS.full 23 24 requestIdSet :: (Read (IdType a), Ord (IdType a), Enum (IdType a), Bounded (IdType a)) => Wai.Request -> IdSet a 25 requestIdSet = pe . mapMaybe ie . Wai.queryString where 26 pe [] = RS.full 27 pe (h:l) = foldl' ae (either RS.complement id h) l 28 ae s (Right i) = s `RS.union` i 29 ae s (Left e) = s `RS.difference` e 30 ie (k, Nothing) = Right <$> ps k 31 ie (k, Just v) 32 | k `BSC.isPrefixOf` "include" = Right <$> ps v 33 | k `BSC.isPrefixOf` "exclude" = Left <$> ps v 34 ie _ = Nothing 35 ps = RS.parseRangeSet . BSC.unpack 36 37 idSetQuery :: (Show (IdType a), Ord (IdType a), Enum (IdType a), Bounded (IdType a)) => IdSet a -> Query 38 idSetQuery s 39 | idSetIsFull s = [] 40 | RS.findMin s == minBound = vs "exclude" $ RS.complement s 41 | otherwise = vs "include" s where 42 vs ie = return . (,) ie . Just . BSC.pack . RS.showRangeSet