module Control.Monad.Apiary.Filter.Internal.Strategy where
import Data.Maybe
import qualified Data.Text as T
import Data.Apiary.Proxy
import Data.Apiary.SList
import Data.Apiary.Document
class Strategy (w :: * -> *) where
type SNext w (as :: [*]) a :: [*]
readStrategy :: (v -> Maybe a)
-> ((k,v) -> Bool)
-> w a
-> [(k, v)]
-> SList as
-> Maybe (SList (SNext w as a))
strategyRep :: forall a. w a -> StrategyRep
getQuery :: (v -> Maybe a) -> w a -> ((k,v) -> Bool) -> [(k, v)] -> [Maybe a]
getQuery readf _ kf = map readf . map snd . filter kf
data Option a = Option deriving Typeable
instance Strategy Option where
type SNext Option as a = Maybe a ': as
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else Just . (::: l) $ case catMaybes rs of
a:_ -> Just a
[] -> Nothing
strategyRep _ = StrategyRep "optional"
data Optional a = Optional T.Text a deriving Typeable
instance Strategy Optional where
type SNext Optional as a = a ': as
readStrategy rf k p@(Optional _ def) q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else Just . (::: l) $ case catMaybes rs of
a:_ -> a
[] -> def
strategyRep (Optional tr _) = StrategyRep $
"default:" `T.append` tr
data First a = First deriving Typeable
instance Strategy First where
type SNext First as a = a ': as
readStrategy rf k p q l =
case getQuery rf p k q of
Just a:_ -> Just $ a ::: l
_ -> Nothing
strategyRep _ = StrategyRep "first"
data One a = One deriving Typeable
instance Strategy One where
type SNext One as a = a ': as
readStrategy rf k p q l =
case getQuery rf p k q of
[Just a] -> Just $ a ::: l
_ -> Nothing
strategyRep _ = StrategyRep "one"
data Many a = Many deriving Typeable
instance Strategy Many where
type SNext Many as a = [a] ': as
readStrategy rf k p q l =
let rs = getQuery rf p k q
in if any isNothing rs
then Nothing
else Just $ (catMaybes rs) ::: l
strategyRep _ = StrategyRep "many"
data Some a = Some deriving Typeable
instance Strategy Some where
type SNext Some as a = [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
as -> Just $ as ::: l
strategyRep _ = StrategyRep "some"
data LimitSome a = LimitSome !Int deriving Typeable
instance Strategy LimitSome where
type SNext LimitSome as a = [a] ': as
readStrategy rf k p@(LimitSome lim) q l =
let rs = take lim $ getQuery rf p k q
in if any isNothing rs
then Nothing
else case catMaybes rs of
[] -> Nothing
as -> Just $ as ::: l
strategyRep (LimitSome lim) = StrategyRep . T.pack $ "less then " ++ show lim
data Check a = Check 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 -> Option a
pOption _ = Option
pOptional :: Show a => a -> Optional a
pOptional def = Optional (T.pack $ show def) def
pFirst :: proxy a -> First a
pFirst _ = First
pOne :: proxy a -> One a
pOne _ = One
pMany :: proxy a -> Many a
pMany _ = Many
pSome :: proxy a -> Some a
pSome _ = Some
pLimitSome :: Int -> proxy a -> LimitSome a
pLimitSome lim _ = LimitSome lim
pCheck :: proxy a -> Check a
pCheck _ = Check