datarobot 0.1.1 → 1.0.0

raw patch · 4 files changed

+102/−64 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• datarobot.cabal +13/−8
• src/DataRobot.hs +1/−2
• src/DataRobot/Predict.hs +3/−4
• src/DataRobot/PredictResponse.hs +85/−50

@@ -1,9 +1,11 @@--- This file has been generated from package.yaml by hpack version 0.17.0.+-- This file has been generated from package.yaml by hpack version 0.20.0. -- -- see: https://github.com/sol/hpack+--+-- hash: d659e0f40eb6ebe5c04a98ee4a259744bfffb63a3269437ce8661118f03926d4  name:                datarobot-version:             0.1.1+version:             1.0.0 synopsis:            Client for DataRobot API description:         Client for DataRobot API homepage:            https://github.com/orbital/datarobot-haskell#readme@@ -31,9 +33,11 @@       DataRobot.Predict       DataRobot.PredictResponse       DataRobot.Types+  other-modules:+      Paths_datarobot   build-depends:-      base >=4.7 && <5-    , aeson+      aeson+    , base >=4.7 && <5     , bytestring     , exceptions     , microlens@@ -54,9 +58,10 @@       test   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >=4.7 && <5-    , aeson+      aeson+    , base     , bytestring+    , datarobot     , exceptions     , microlens     , network-uri@@ -67,6 +72,6 @@     , unordered-containers     , vector     , wreq-    , base-    , datarobot+  other-modules:+      Paths_datarobot   default-language: Haskell2010

@@ -16,8 +16,7 @@   , Fields   , PredictError(..)   , PredictResult(..)-  , responseResult-  , classProbability+  , predictionValue   

@@ -11,14 +11,14 @@ import Lens.Micro ((?~), (.~)) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Catch (MonadThrow)-import Data.Aeson (Value(..))+import Data.Aeson (Value(..), encode) import Data.Function ((&)) import qualified Data.HashMap.Strict as HM import qualified Data.Vector as V import Data.String.Conversions (cs)  import DataRobot.Types-import DataRobot.API (parseResponse, endpoint)+import DataRobot.API (endpoint) import DataRobot.PredictResponse  import Network.URI (URI(..))@@ -34,8 +34,7 @@       url = predictURI (baseURLPredict c) pid mid       body = Array $ V.singleton $ Object $ HM.fromList o   r <- liftIO $ Wreq.postWith opts url body-  pr <- parseResponse r-  pure $ responseResult pr+  pure $ parseResponse r   httpOptions :: Credentials -> Wreq.Options

@@ -4,22 +4,32 @@ module DataRobot.PredictResponse   ( PredictError(..)   , PredictResult(..)-  , responseResult-  , classProbability+  , PredictionValue(..)+  , parseResponse+  , predictionValue   ) where--import Control.Applicative ((<|>)) import Control.Monad.Catch (Exception)-import Data.Aeson (FromJSON(..), ToJSON, Value)-import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HM-import Data.Maybe (fromMaybe)+import Data.Aeson (FromJSON(..), ToJSON, Value(..), decode, defaultOptions, genericParseJSON, withObject, (.:), eitherDecode)+import Data.Aeson.Types (Options(..), typeMismatch)+import Data.List (find)+import Data.Maybe (fromMaybe, maybe) import Data.Text (Text)+import Data.String.Conversions (cs) import Data.Typeable (Typeable) import GHC.Generics (Generic) import Safe (headMay) +import Lens.Micro ((^.))+import Network.Wreq (Response, responseBody, responseHeader)+import Data.ByteString.Lazy (ByteString) ++underscorePrefixOptions :: Options+underscorePrefixOptions =+  defaultOptions { fieldLabelModifier = dropWhile (== '_') }++type Code = Int+ data PredictError     = APIError Code Text     | MissingPrediction@@ -28,67 +38,92 @@ instance Exception PredictError  -newtype PredictResponse = PredictResponse (Either PredictFailure PredictSuccess )-    deriving (Show, Eq)+-- Datarobot successful response+data ResponseSuccess = ResponseSuccess+  { _data :: [Prediction]+  } deriving (Eq, Show, Generic) -instance FromJSON PredictResponse where-    parseJSON v = PredictResponse <$>-      ((Right <$> parseJSON v) <|> (Left <$> parseJSON v))+instance FromJSON ResponseSuccess where+  parseJSON = genericParseJSON underscorePrefixOptions -type Code = Int -data PredictFailure = PredictFailure-  { code :: Code-  , status :: Text+-- Datarobot failure response+data ResponseFailure = ResponseFailure+  { _message :: Text   } deriving (Show, Eq, Generic) -instance FromJSON PredictFailure+instance FromJSON ResponseFailure where+  parseJSON = genericParseJSON underscorePrefixOptions -data PredictSuccess = PredictSuccess-  { predictions :: [Prediction]-  , execution_time :: Float-  , model_id :: Text-  -- , task :: Text-  } deriving (Show, Eq, Generic) -instance FromJSON PredictSuccess+-- A single prediction value+data PredictionValue = PredictionValue+  { label :: Text+  , value :: Float+  } deriving (Eq, Show, Generic) +instance ToJSON PredictionValue+instance FromJSON PredictionValue where+  parseJSON = withObject "prediction_value" $ \o -> do+      value' <- o .: "value"+      label' <- labelText =<< o .: "label"+      return $ PredictionValue label' value'+    where+      -- Always treat the label as text even though the JSON also allows numbers+      -- This makes key-based lookup easier on the API consumer+      labelText (Number n) = pure $ (cs .show) n+      labelText (String s) = pure s+      labelText invalid    = typeMismatch "label" invalid+++-- Combination of prediction values and prediction label data Prediction = Prediction-  { prediction :: Value-  , class_probabilities :: Maybe (HashMap Text Float)-  } deriving (Show, Eq, Generic)+  { _prediction       :: Value  -- label or float+  , _predictionValues :: Maybe [PredictionValue]+  } deriving (Eq, Show, Generic) -instance FromJSON Prediction+instance FromJSON Prediction where+  parseJSON = genericParseJSON underscorePrefixOptions    -- | Result from the prediction- data PredictResult = PredictResult-  { prediction :: Value+  { prediction       :: Value   , predictionTimeMs :: Float-  , modelId :: Text-  , classProbabilities :: Maybe (HashMap Text Float)+  , predictionValues :: Maybe [PredictionValue]   } deriving (Show, Eq, Generic) -instance ToJSON PredictResult -responseResult :: PredictResponse -> Either PredictError PredictResult-responseResult (PredictResponse (Right ps)) =-      fromMaybe (Left MissingPrediction) $ do-        p <- headMay (predictions ps)-        return $ Right $ PredictResult-          { prediction = prediction (p :: Prediction)-          , predictionTimeMs = execution_time ps-          , modelId = model_id ps-          , classProbabilities = class_probabilities p-          }-responseResult (PredictResponse (Left pf)) =-    Left $ APIError (code pf) (status pf)+-- Create a result for a successful response+responseSuccess :: Float -> ResponseSuccess -> Either PredictError PredictResult+responseSuccess et rs =+    maybe (Left MissingPrediction) Right $ do+        p <- headMay (_data rs)+        pure PredictResult+            { prediction       = _prediction p+            , predictionValues = _predictionValues p+            , predictionTimeMs = et+            } +-- Create a result for a failed response+responseFailure :: Text -> Either PredictError PredictResult+responseFailure e = Left $ APIError 422 e -classProbability :: Text -> PredictResult -> Maybe Float-classProbability c r = do-    cps <- classProbabilities r-    HM.lookup c cps+-- Parse the entire prediction response+-- This is needed because some of the data is delivered in the body and some is delivered via headers+parseResponse :: Response ByteString -> Either PredictError PredictResult+parseResponse r = do+    either (responseFailure . cs) (responseSuccess tm) $ eitherDecode b+    where+      b  = r ^. responseBody+      et = r ^. responseHeader "X-DataRobot-Execution-Time"+      tm = fromMaybe 0.0 $ decode (cs et)++-- Find a prediction value probability from a given label+predictionValue :: Text -> PredictResult -> Maybe Float+predictionValue c r = do+    ps <- predictionValues r+    pd <- find ((== c) . label) ps+    pure $ value pd