{-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module TS.B01 where -------------------------------------------------------------------------------- import Control.Applicative import Control.DeepSeq (NFData(..)) import Control.Lens -------------------------------------------------------------------------------- import qualified Data.IntSet import Data.Foldable (toList) -------------------------------------------------------------------------------- import Common (C01(..)) -------------------------------------------------------------------------------- import qualified Data.Table as T -------------------------------------------------------------------------------- size :: T.Table t -> Int size = T.count instance T.Tabular C01 where type PKT C01 = Int data Key k C01 b where D1 :: T.Key T.Primary C01 Int D2 :: T.Key T.SupplementalInt C01 Int D3 :: T.Key T.InvertedInt C01 Data.IntSet.IntSet data Tab C01 i = C01IX { ixd1 :: i T.Primary Int , ixd2 :: i T.SupplementalInt Int , ixd3 :: i T.InvertedInt Data.IntSet.IntSet } fetch D1 (C01 x _ _) = x fetch D2 (C01 _ x _) = x fetch D3 (C01 _ _ x) = Data.IntSet.fromList x primary = D1 primarily D1 r = r mkTab f = C01IX <$> f D1 <*> f D2 <*> f D3 forTab (C01IX d1 d2 d3) f = C01IX <$> f D1 d1 <*> f D2 d2 <*> f D3 d3 ixTab (C01IX x _ _) D1 = x ixTab (C01IX _ x _) D2 = x ixTab (C01IX _ _ x) D3 = x instance NFData (T.Tab C01 (T.AnIndex C01)) where rnf (C01IX x1 x2 x3) = rnf x1 `seq` rnf x2 `seq` rnf x3 type TS = T.Table C01 insert :: C01 -> TS -> TS insert = T.insert lookupOOEQ :: Int -> TS -> [C01] lookupOOEQ x o = toList (o ^. T.with D1 (==) x) lookupOOGE :: Int -> TS -> [C01] lookupOOGE x o = toList (o ^. T.with D1 (>=) x) lookupOMEQ :: Int -> TS -> [C01] lookupOMEQ x o = toList (o ^. T.with D2 (==) x) lookupOMGE :: Int -> TS -> [C01] lookupOMGE x o = toList (o ^. T.with D2 (>=) x) lookupMMEQ :: Int -> TS -> [C01] lookupMMEQ x o = toList (o ^. T.withAny D3 [x]) empty :: TS empty = T.empty