colorless 2.2.8 → 2.2.9

raw patch · 8 files changed

+76/−31 lines, 8 files

Files

• colorless.cabal +3/−1
• library/Colorless/Endpoint.hs +26/−22
• library/Colorless/RuntimeThrower.hs +17/−0
• library/Colorless/Server.hs +4/−0
• library/Colorless/Server/Expr.hs +1/−0
• library/Colorless/ServiceThrower.hs +18/−0
• library/Colorless/Types.hs +6/−7
• package.yaml +1/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           colorless-version:        2.2.8+version:        2.2.9 synopsis:       Colorless description:    Colorless category:       Web@@ -47,9 +47,11 @@       Colorless.Endpoint       Colorless.Imports       Colorless.Prim+      Colorless.RuntimeThrower       Colorless.Server       Colorless.Server.Exchange       Colorless.Server.Expr+      Colorless.ServiceThrower       Colorless.Types       Colorless.Val   default-language: Haskell2010

@@ -7,6 +7,7 @@ import qualified Data.Map as Map import qualified Data.HashMap.Lazy as HML import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Except import Control.Concurrent.Async.Lifted () import Data.Aeson import Data.Aeson.Types (parseMaybe)@@ -15,39 +16,42 @@  import Colorless.Types import Colorless.Server.Exchange+import Colorless.RuntimeThrower  runColorlessSingleton-  :: (MonadIO m, RuntimeThrower m)+  :: MonadIO m   => Version-  -> (Request -> m Response)+  -> (Request -> m (Either Response Response))   -> Value   -> m Value runColorlessSingleton Version{major,minor} handleRequest = runColorless (Map.singleton major (minor, handleRequest))  runColorless-  :: (MonadIO m, RuntimeThrower m)-  => Map Major (Minor, Request -> m Response)+  :: MonadIO m+  => Map Major (Minor, Request -> m (Either Response Response))   -> Value   -> m Value runColorless handleRequestMap v = do-  colorlessVersion <- getColorlessVersion v-  assertColorlessVersionCompatiability colorlessVersion-  apiVersion <- getApiVersion v-  let apiMajor = major apiVersion-  case Map.lookup apiMajor handleRequestMap of-    Nothing -> case leastAndGreatest (Map.keys handleRequestMap) of-      Nothing -> runtimeThrow RuntimeError'NoImplementation-      Just (minMajor, maxMajor) ->-        if minMajor > apiMajor-          then runtimeThrow RuntimeError'ApiMajorVersionTooLow-          else if maxMajor < apiMajor-            then runtimeThrow RuntimeError'ApiMajorVersionTooHigh-            else runtimeThrow RuntimeError'NoImplementation-    Just (maxMinor, handleRequest) -> if minor apiVersion > maxMinor-      then runtimeThrow RuntimeError'ApiMinorVersionTooHigh-      else case parseRequest v of-        Nothing -> runtimeThrow RuntimeError'UnparsableFormat-        Just req -> toJSON <$> handleRequest req+  e <- runExceptT $ do+    colorlessVersion <- getColorlessVersion v+    assertColorlessVersionCompatiability colorlessVersion+    apiVersion <- getApiVersion v+    let apiMajor = major apiVersion+    case Map.lookup apiMajor handleRequestMap of+      Nothing -> case leastAndGreatest (Map.keys handleRequestMap) of+        Nothing -> runtimeThrow RuntimeError'NoImplementation+        Just (minMajor, maxMajor) ->+          if minMajor > apiMajor+            then runtimeThrow RuntimeError'ApiMajorVersionTooLow+            else if maxMajor < apiMajor+              then runtimeThrow RuntimeError'ApiMajorVersionTooHigh+              else runtimeThrow RuntimeError'NoImplementation+      Just (maxMinor, handleRequest) -> if minor apiVersion > maxMinor+        then runtimeThrow RuntimeError'ApiMinorVersionTooHigh+        else case parseRequest v of+          Nothing -> runtimeThrow RuntimeError'UnparsableFormat+          Just req -> toJSON <$> ExceptT (handleRequest req)+  return $ either toJSON id e  leastAndGreatest :: Ord a => [a] -> Maybe (a,a) leastAndGreatest [] = Nothing

@@ -0,0 +1,17 @@+module Colorless.RuntimeThrower+  ( RuntimeThrower(..)+  ) where++import Control.Monad.Except++import qualified Colorless.Server.Exchange as Server+import Colorless.Types++class Monad m => RuntimeThrower m where+  runtimeThrow :: RuntimeError -> m a++instance RuntimeThrower IO where+  runtimeThrow err = error $ "Runtime error - " ++ show err++instance Monad m => RuntimeThrower (ExceptT Server.Response m) where+  runtimeThrow = throwError . Server.Response'Error . Server.ResponseError'Runtime

@@ -3,9 +3,13 @@   , module Colorless.Val   , module Colorless.Server.Expr   , module Colorless.Server.Exchange+  , module Colorless.RuntimeThrower+  , module Colorless.ServiceThrower   ) where  import Colorless.Val (ToVal(..), FromVal(..), getMember, fromValFromJson, combineObjects) import Colorless.Types import Colorless.Server.Expr import Colorless.Server.Exchange+import Colorless.RuntimeThrower+import Colorless.ServiceThrower

@@ -58,6 +58,7 @@ import Colorless.Ast (Ast(..)) import Colorless.Val import Colorless.Prim+import Colorless.RuntimeThrower  data EvalConfig m = EvalConfig   { options :: Options

@@ -0,0 +1,18 @@+module Colorless.ServiceThrower+  ( ServiceThrower(..)+  ) where++import Control.Monad.Except+import Data.Aeson++import qualified Colorless.Server.Exchange as Server+import Colorless.Types++class Monad m => ServiceThrower m where+  serviceThrow :: Value -> m a++instance ServiceThrower IO where+  serviceThrow err = error $ "Service error - " ++ show err++instance Monad m => ServiceThrower (ExceptT Server.Response m) where+  serviceThrow = throwError . Server.Response'Error . Server.ResponseError'Service

@@ -6,8 +6,8 @@   , Pull(..)   , pullAddress   , RuntimeError(..)-  , RuntimeThrower(..)   , Options(..)+  , defOptions   --   , Symbol(..)   , Type(..)@@ -133,15 +133,14 @@       _ -> mzero   parseJSON _ = mzero -class Monad m => RuntimeThrower m where-  runtimeThrow :: RuntimeError -> m a--instance RuntimeThrower IO where-  runtimeThrow err = error $ "Runtime error - " ++ show err- data Options = Options   { variableLimit :: Maybe Int   } deriving (Show, Eq)++defOptions :: Options+defOptions = Options+  { variableLimit = Just 100+  }  -- 

@@ -1,5 +1,5 @@ name: colorless-version: '2.2.8'+version: '2.2.9' category: Web synopsis: Colorless description: Colorless