module Database.Orchestrate.Types
(
APIKey
, Collection
, Key
, Ref
, Timestamp
, Location
, RestCall
, Limit
, Offset
, IfMatch'
, IfMatch(..)
, Range
, RangeEnd(..)
, KVList
, TombstoneItem(..)
, _TombstoneItem
, _LiveItem
, livePath
, liveTime
, liveValue
, tombstonePath
, tombstoneTime
, EventList
, EventType
, EventPath(..)
, eventPath
, eventPathType
, eventPathTime
, eventPathOrd
, EventItem(..)
, eventItem
, eventTime
, eventOrd
, RelKind
, RelList
, QueryText
, SearchList(..)
, searchResults
, searchTotal
, SearchItem(..)
, searchItem
, searchScore
, Session(..)
, sessionURL
, sessionKey
, sessionVersion
, sessionOptions
, OrchestrateData(..)
, OrchestrateT(..)
, OrchestrateIO
, Orchestrate
, ResultList(..)
, resultCount
, resultList
, resultPrev
, resultNext
, ResultItem(..)
, itemPath
, itemValue
, Path(..)
, itemCollection
, itemKey
, itemRef
, ask
, asks
, throwError
, catchError
) where
import Control.Error
import qualified Control.Exception as Ex
import Control.Lens hiding ((.=))
import Control.Monad
import Control.Monad.Error.Class
import Control.Monad.Reader
import Data.Aeson
import Data.Aeson.Types (Parser)
import Data.Default
import qualified Data.HashMap.Strict as M
import qualified Data.Text as T
import Network.Wreq
type APIKey = T.Text
type Collection = T.Text
type Key = T.Text
type Ref = T.Text
type Timestamp = Integer
type Location = T.Text
type IfMatch' = Maybe Ref
type Limit = Int
type Offset = Int
type EventType = T.Text
type RelKind = T.Text
type QueryText = T.Text
type RestCall a = Options -> String -> IO (Response a)
data IfMatch = IfMatch Ref
| IfNoneMatch Ref
| NoMatch
deriving (Show)
type Range a = (RangeEnd a, RangeEnd a)
data RangeEnd a = Inclusive a
| Exclusive a
| Open
deriving (Show, Functor)
data Session = Session
{ _sessionURL :: !T.Text
, _sessionKey :: !APIKey
, _sessionVersion :: !Int
, _sessionOptions :: !Options
} deriving (Show)
$(makeLenses ''Session)
instance Default Session where
def = Session "https://api.orchestrate.io" "" 0
$ defaults & header "Content-Type" .~ ["application/json"]
& header "Accept" .~ ["application/json"]
class (ToJSON a, FromJSON a) => OrchestrateData a where
tableName :: a -> Collection
dataKey :: a -> Key
newtype OrchestrateT m a
= OrchestrateT
{ runOrchestrate :: ExceptT Ex.SomeException (ReaderT Session m) a }
deriving (Functor, Applicative, Monad)
instance MonadTrans OrchestrateT where
lift = OrchestrateT . lift . lift
instance MonadIO m => MonadIO (OrchestrateT m) where
liftIO = OrchestrateT . liftIO . liftIO
instance Monad m => MonadReader Session (OrchestrateT m) where
ask = OrchestrateT . lift $ ask
local f = OrchestrateT . local f . runOrchestrate
instance Monad m => MonadError Ex.SomeException (OrchestrateT m) where
throwError = OrchestrateT . ExceptT . return . Left
catchError a handler = join
. fmap (handler' handler)
. lift
. runReaderT (runExceptT $ runOrchestrate a)
=<< ask
handler' :: Monad m
=> (Ex.SomeException -> OrchestrateT m a)
-> Either Ex.SomeException a
-> OrchestrateT m a
handler' _ (Right v) = return v
handler' f (Left e) = f e
type Orchestrate = OrchestrateT Identity
type OrchestrateIO = OrchestrateT IO
data Path = Path
{ _itemCollection :: !Collection
, _itemKey :: !Key
, _itemRef :: !Ref
} deriving (Show)
$(makeLenses ''Path)
instance FromJSON Path where
parseJSON (Object o) = Path
<$> o .: "collection"
<*> o .: "key"
<*> o .: "ref"
parseJSON _ = mzero
instance ToJSON Path where
toJSON (Path c k r) = object [ "collection" .= c
, "key" .= k
, "ref" .= r
]
data ResultList i = ResultList
{ _resultCount :: !Int
, _resultList :: ![i]
, _resultPrev :: !(Maybe Location)
, _resultNext :: !(Maybe Location)
} deriving (Show)
$(makeLenses ''ResultList)
instance FromJSON r => FromJSON (ResultList r) where
parseJSON (Object o) = ResultList
<$> o .: "count"
<*> o .: "results"
<*> o .:? "prev"
<*> o .:? "next"
parseJSON _ = mzero
data ResultItem p v = ResultItem
{ _itemPath :: !p
, _itemValue :: !v
} deriving (Show)
$(makeLenses ''ResultItem)
instance (FromJSON p, FromJSON v) => FromJSON (ResultItem p v) where
parseJSON (Object o) = ResultItem
<$> o .: "path"
<*> o .: "value"
parseJSON _ = mzero
instance (ToJSON p, ToJSON v) => ToJSON (ResultItem p v) where
toJSON (ResultItem p v) = object ["path" .= p, "value" .= v]
data EventPath = EventPath
{ _eventPath :: !Path
, _eventPathType :: !EventType
, _eventPathTime :: !Timestamp
, _eventPathOrd :: !Int
} deriving (Show)
$(makeLenses ''EventPath)
instance FromJSON EventPath where
parseJSON o'@(Object o) = EventPath
<$> parseJSON o'
<*> o .: "type"
<*> o .: "timestamp"
<*> o .: "ordinal"
parseJSON _ = mzero
instance ToJSON EventPath where
toJSON (EventPath p et ts o) =
Object $ case toJSON p of
Object m -> m `M.union` epm
_ -> epm
where epm = M.fromList [ ("type", toJSON et)
, ("timestamp", toJSON ts)
, ("ordinal", toJSON o)
]
data EventItem a b = EventItem
{ _eventItem :: !(ResultItem EventPath a)
, _eventTime :: !Timestamp
, _eventOrd :: !Int
} deriving (Show)
$(makeLenses ''EventItem)
instance FromJSON a => FromJSON (EventItem a b) where
parseJSON o'@(Object o) = EventItem
<$> parseJSON o'
<*> o .: "timestamp"
<*> o .: "ordinal"
parseJSON _ = mzero
data TombstoneItem v =
TombstoneItem { _tombstonePath :: !Path
, _tombstoneTime :: !Timestamp
}
| LiveItem { _livePath :: !Path
, _liveValue :: !(Maybe v)
, _liveTime :: !Timestamp
}
deriving (Show)
$(makeLenses ''TombstoneItem)
_TombstoneItem :: Prism' (TombstoneItem v) (TombstoneItem v)
_TombstoneItem = prism' id $ \i ->
case i of
TombstoneItem{} -> Just i
LiveItem{} -> Nothing
_LiveItem :: Prism' (TombstoneItem v) (TombstoneItem v)
_LiveItem = prism' id $ \i ->
case i of
TombstoneItem{} -> Nothing
LiveItem{} -> Just i
emptyObject :: FromJSON v => Maybe Value -> Parser (Maybe v)
emptyObject (Just o@(Object m)) | M.null m = return Nothing
| otherwise = parseJSON o
emptyObject _ = return Nothing
instance FromJSON v => FromJSON (TombstoneItem v) where
parseJSON (Object o) = do
let path = o .: "path"
reftime = o .: "reftime"
(Object p) <- o .: "path"
tombstone <- p .:? "tombstone"
case tombstone of
Just (Bool True) -> TombstoneItem <$> path <*> reftime
_ -> LiveItem <$> path <*> (emptyObject =<< o .:? "value") <*> reftime
parseJSON _ = mzero
data SearchItem v = SearchItem
{ _searchItem :: !(ResultItem Path v)
, _searchScore :: !Double
} deriving (Show)
$(makeLenses ''SearchItem)
instance FromJSON v => FromJSON (SearchItem v) where
parseJSON o'@(Object o) = SearchItem
<$> parseJSON o'
<*> o .: "score"
parseJSON _ = mzero
data SearchList v = SearchList
{ _searchResults :: !(ResultList (SearchItem v))
, _searchTotal :: !Int
} deriving (Show)
$(makeLenses ''SearchList)
instance FromJSON v => FromJSON (SearchList v) where
parseJSON o'@(Object o) = SearchList
<$> parseJSON o'
<*> o .: "total_count"
parseJSON _ = mzero
type EventList a b = ResultList (EventItem a b)
type RelList a b = ResultList (ResultItem Path b)
type KVList v = ResultList (ResultItem Path v)