module EZCouch.ReadAction where
import Prelude ()
import ClassyPrelude.Conduit
import EZCouch.Action
import EZCouch.Entity
import EZCouch.Types
import EZCouch.Parsing
import EZCouch.View
import qualified EZCouch.Encoding as Encoding
import qualified Database.CouchDB.Conduit.View.Query as CC
import qualified System.Random as Random
import qualified EZCouch.Base62 as Base62
import qualified Network.HTTP.Conduit as HTTP
import qualified Network.HTTP.Types as HTTP
import Data.Aeson.Types
data KeysSelection k
= KeysSelectionAll
| KeysSelectionRange k k
| KeysSelectionRangeStart k
| KeysSelectionRangeEnd k
| KeysSelectionList [k]
deriving (Show, Eq)
readAction :: (MonadAction m, Entity a, ToJSON k)
=> View a k
-> KeysSelection k
-> Int
-> Maybe Int
-> Bool
-> Bool
-> m Value
readAction view mode skip limit desc includeDocs =
action path qps body `catch` \e -> case e of
HTTP.StatusCodeException (HTTP.Status code _) _
| code `elem` [404, 500]
-> do
createOrUpdateView view
action path qps body
_ -> throwIO e
where
action = case mode of
KeysSelectionList {} -> postAction
_ -> getAction
path = viewPath view
qps = catMaybes [
includeDocsQP includeDocs,
startKeyQP view mode,
endKeyQP view mode,
descQP desc,
limitQP limit,
skipQP skip
]
body = case mode of
KeysSelectionList keys -> Encoding.keysBody keys
_ -> ""
startKeyQP _ (KeysSelectionRange start end) = Just $ CC.QPStartKey start
startKeyQP _ (KeysSelectionRangeStart start) = Just $ CC.QPStartKey start
startKeyQP _ (KeysSelectionList {}) = Nothing
startKeyQP view@ViewById _ = Just $ CC.QPStartKey $ viewDocType view ++ "-"
startKeyQP _ _ = Nothing
endKeyQP _ (KeysSelectionRange start end) = Just $ CC.QPEndKey end
endKeyQP _ (KeysSelectionRangeEnd end) = Just $ CC.QPEndKey end
endKeyQP _ (KeysSelectionList {}) = Nothing
endKeyQP view@ViewById _ = Just $ CC.QPEndKey $ viewDocType view ++ "."
endKeyQP _ _ = Nothing
limitQP limit = CC.QPLimit <$> limit
skipQP skip = if skip /= 0 then Just $ CC.QPSkip skip else Nothing
descQP desc = if desc then Just CC.QPDescending else Nothing
includeDocsQP True = Just CC.QPIncludeDocs
includeDocsQP False = Nothing
readKeys :: (MonadAction m, Entity a, ToJSON k, FromJSON k)
=> View a k
-> KeysSelection k
-> m [k]
readKeys view mode = fmap (map fst . filter snd) $ readKeysExist view mode
readCount :: (MonadAction m, Entity a, ToJSON k, FromJSON k)
=> View a k
-> KeysSelection k
-> m Int
readCount view mode = fmap length $ readKeys view mode
readKeysExist :: (MonadAction m, Entity a, ToJSON k, FromJSON k)
=> View a k
-> KeysSelection k
-> m [(k, Bool)]
readKeysExist view mode =
readAction view mode 0 Nothing False False
>>= runParser (rowsParser1 >=> mapM keyExistsParser . toList)
readEntities :: (MonadAction m, Entity a, ToJSON k)
=> View a k
-> KeysSelection k
-> Int
-> Maybe Int
-> Bool
-> m [Persisted a]
readEntities view mode skip limit desc =
readAction view mode skip limit desc True
>>= runParser (rowsParser1 >=> mapM persistedParser . toList)
>>= return . catMaybes
readEntity :: (MonadAction m, Entity a, ToJSON k)
=> View a k
-> KeysSelection k
-> Int
-> Bool
-> m (Maybe (Persisted a))
readEntity view mode skip desc =
listToMaybe <$> readEntities view mode skip (Just 1) desc
readRandomEntities :: (MonadAction m, Entity a)
=> Maybe Int
-> m [Persisted a]
readRandomEntities limit = do
startKey :: Double <- liftIO $ Random.randomRIO (0.0, 1.0)
readEntities
(ViewByKeys1 ViewKeyRandom)
(KeysSelectionRangeStart startKey)
0
limit
False