module Control.Monad.Apiary.Filter.Internal.Strategy where
import Data.Apiary.SList
import qualified Data.Text as T
import Data.Apiary.Document
import Data.Typeable
import Data.Maybe
import Data.Reflection
#if __GLASGOW_HASKELL__ < 707
import Data.Proxy
#endif
class Strategy (w :: * -> *) where
type SNext w (as :: [*]) a :: [*]
readStrategy :: (v -> Maybe a)
-> ((k,v) -> Bool)
-> proxy (w a)
-> [(k, v)]
-> SList as
-> Maybe (SList (SNext w as a))
strategyRep :: proxy w -> StrategyRep
getQuery :: (v -> Maybe a) -> proxy (w a) -> ((k,v) -> Bool) -> [(k, v)] -> [Maybe a]
getQuery readf _ kf = map readf . map snd . filter kf
data Option a deriving Typeable
instance Strategy Option where
type SNext Option as a = Snoc as (Maybe a)
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else Just . sSnoc l $ case catMaybes rs of
[] -> Nothing
a:_ -> Just a
strategyRep _ = StrategyRep "optional"
data First a deriving Typeable
instance Strategy First where
type SNext First as a = Snoc as a
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[] -> Nothing
a:_ -> Just $ sSnoc l a
strategyRep _ = StrategyRep "first"
data One a deriving Typeable
instance Strategy One where
type SNext One as a = Snoc as a
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[a] -> Just $ sSnoc l a
_ -> Nothing
strategyRep _ = StrategyRep "one"
data Many a deriving Typeable
instance Strategy Many where
type SNext Many as a = Snoc as [a]
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else Just $ sSnoc l (catMaybes rs)
strategyRep _ = StrategyRep "many"
data Some a deriving Typeable
instance Strategy Some where
type SNext Some as a = Snoc as [a]
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[] -> Nothing
as -> Just $ sSnoc l as
strategyRep _ = StrategyRep "some"
data LimitSome u a deriving Typeable
instance (Reifies u Int) => Strategy (LimitSome u) where
type SNext (LimitSome u) as a = Snoc as [a]
readStrategy rf k p q l =
let rs = take (reflectLimit p) $ getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[] -> Nothing
as -> Just $ sSnoc l as
strategyRep _ = StrategyRep . T.pack $ "less then " ++ show (reflect (Proxy :: Proxy u))
reflectLimit :: Reifies n Int => proxy (LimitSome n a) -> Int
reflectLimit p = reflect $ asTyInt p
where
asTyInt :: proxy (LimitSome u a) -> Proxy u
asTyInt _ = Proxy
data Check a deriving Typeable
instance Strategy Check where
type SNext Check as a = as
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[] -> Nothing
_ -> Just l
strategyRep _ = StrategyRep "check"
pOption :: proxy a -> Proxy (Option a)
pOption _ = Proxy
pFirst :: proxy a -> Proxy (First a)
pFirst _ = Proxy
pOne :: proxy a -> Proxy (One a)
pOne _ = Proxy
pMany :: proxy a -> Proxy (Many a)
pMany _ = Proxy
pSome :: proxy a -> Proxy (Some a)
pSome _ = Proxy
pCheck :: proxy a -> Proxy (Check a)
pCheck _ = Proxy