colorless 2.2.18 → 2.2.19

raw patch · 7 files changed

+401/−12 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• colorless.cabal +1/−1
• library/Colorless/Ast.hs +74/−0
• library/Colorless/Client/Expr.hs +24/−2
• library/Colorless/Server/Expr.hs +292/−6
• library/Colorless/ServiceThrower.hs +6/−2
• library/Colorless/Types.hs +3/−0
• package.yaml +1/−1

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           colorless-version:        2.2.18+version:        2.2.19 synopsis:       Colorless | The Programmatic IDL description:    Colorless | The Programmatic IDL category:       Web

@@ -4,8 +4,12 @@   , ToAst(..)   , Ref(..)   , If(..)+  , Iflet(..)   , Get(..)+  , Set(..)   , Define(..)+  , Match(..)+  , MatchCase(..)   , Lambda(..)   , List(..)   , Tuple(..)@@ -38,8 +42,11 @@ data Ast   = Ast'Ref Ref   | Ast'If If+  | Ast'Iflet Iflet   | Ast'Get Get+  | Ast'Set Set   | Ast'Define Define+  | Ast'Match Match   | Ast'Lambda Lambda   | Ast'List List   | Ast'Tuple Tuple@@ -245,8 +252,11 @@   parseJSON v     =   (Ast'Ref <$> parseJSON v)     <|> (Ast'If <$> parseJSON v)+    <|> (Ast'Iflet <$> parseJSON v)     <|> (Ast'Get <$> parseJSON v)+    <|> (Ast'Set <$> parseJSON v)     <|> (Ast'Define <$> parseJSON v)+    <|> (Ast'Match <$> parseJSON v)     <|> (Ast'Lambda <$> parseJSON v)     <|> (Ast'List <$> parseJSON v)     <|> (Ast'Tuple <$> parseJSON v)@@ -264,8 +274,11 @@   toJSON = \case     Ast'Ref a -> toJSON a     Ast'If a -> toJSON a+    Ast'Iflet a -> toJSON a     Ast'Get a -> toJSON a+    Ast'Set a -> toJSON a     Ast'Define a -> toJSON a+    Ast'Match a -> toJSON a     Ast'Lambda a -> toJSON a     Ast'List a -> toJSON a     Ast'Tuple a -> toJSON a@@ -306,6 +319,22 @@ instance ToJSON If where   toJSON If{cond,true,false} = toJSON ["if", toJSON cond, toJSON true, toJSON false] +data Iflet = Iflet+  { symbol :: Symbol+  , option :: Ast+  , some :: Ast+  , none :: Ast+  } deriving (Show, Eq)++instance FromJSON Iflet where+  parseJSON (Array arr) = case V.toList arr of+    ["iflet", symbol, option, some, none] -> Iflet <$> parseJSON symbol <*> parseJSON option <*> parseJSON some <*> parseJSON none+    _ -> mzero+  parseJSON _ = mzero++instance ToJSON Iflet where+  toJSON Iflet{symbol,option,some,none} = toJSON ["iflet", toJSON symbol, toJSON option, toJSON some, toJSON none]+ data Get = Get   { path :: [Text]   , val :: Ast@@ -320,6 +349,21 @@ instance ToJSON Get where   toJSON Get{path,val} = toJSON ["get", toJSON path, toJSON val] +data Set = Set+  { path :: [Text]+  , src :: Ast+  , dest :: Ast+  } deriving (Show, Eq)++instance FromJSON Set where+  parseJSON (Array arr) = case V.toList arr of+    ["set", path, src, dest] -> Set <$> parseJSON path <*> parseJSON src <*> parseJSON dest+    _ -> mzero+  parseJSON _ = mzero++instance ToJSON Set where+  toJSON Set{path,src,dest} = toJSON ["set", toJSON path, toJSON src, toJSON dest]+ data Define = Define   { var :: Symbol   , expr :: Ast@@ -333,6 +377,36 @@  instance ToJSON Define where   toJSON Define{var,expr} = toJSON ["def", toJSON var, toJSON expr]++data MatchCase+  = MatchCase'Tag EnumeralName Ast+  | MatchCase'Members EnumeralName Symbol Ast+  deriving (Show, Eq)++instance ToJSON MatchCase where+  toJSON (MatchCase'Tag name ast) = toJSON [toJSON name, toJSON ast]+  toJSON (MatchCase'Members name sym ast) = toJSON [toJSON name, toJSON sym, toJSON ast]++instance FromJSON MatchCase where+  parseJSON (Array arr) = case V.toList arr of+    [name, ast] -> MatchCase'Tag <$> parseJSON name <*> parseJSON ast+    [name, sym, ast] -> MatchCase'Members <$> parseJSON name <*> parseJSON sym <*> parseJSON ast+    _ -> mzero+  parseJSON _ = mzero++data Match = Match+  { enumeral :: Ast+  , cases :: [MatchCase]+  } deriving (Show, Eq)++instance FromJSON Match where+  parseJSON (Array arr) = case V.toList arr of+    ("match":enumeral:cases) -> Match <$> parseJSON enumeral <*> mapM parseJSON cases+    _ -> mzero+  parseJSON _ = mzero++instance ToJSON Match where+  toJSON Match{enumeral, cases} = toJSON $ ["match", toJSON enumeral] ++ map toJSON cases  data Lambda = Lambda   { args :: [(Symbol, Type)]

@@ -17,10 +17,13 @@   , defn   , defnRec   , iF+  , iflet   , get+  , set   , dot   , (<.>)   --+  , noT   , eq   , neq   , addI8@@ -75,6 +78,9 @@   , list   , eitheR   --+  , mapLeft+  , mapRight+  , mapOption   , mapList   , filterList   , reduceList@@ -316,6 +322,9 @@ iF :: HasType a => Expr Bool -> Expr a -> Expr a -> Expr a iF cond t f = Expr (Ast'If $ Ast.If (toAst cond) (toAst t) (toAst f)) +iflet :: HasType a => Symbol -> Expr (Maybe a) -> (Expr a -> Expr b) -> Expr b -> Expr b+iflet sym opt s n = Expr $ Ast'Iflet $ Ast.Iflet sym (toAst opt) (toAst $ s (Expr $ Ast'Ref $ Ast.Ref sym)) (toAst n)+ --  newtype Path f = Path [T.Text]@@ -333,8 +342,14 @@ get :: (HasType a, HasType b) => Path (a -> b) -> Expr a -> Expr b get (Path path) expr = Expr $ Ast'Get $ Ast.Get path (toAst expr) +set :: (HasType a, HasType b) => Path (a -> b) -> Expr b -> Expr a -> Expr a+set (Path path) src dest = Expr $ Ast'Set $ Ast.Set path (toAst src) (toAst dest)+ -- +noT :: Expr Bool -> Expr Bool+noT x = Expr (Ast'FnCall $ Ast.FnCall (Ast'Ref $ Ast.Ref "not") [toAst x])+ eq :: (HasType a) => Expr a -> Expr a -> Expr Bool eq x y = Expr (Ast'FnCall $ Ast.FnCall (Ast'Ref $ Ast.Ref "eq") [toAst x, toAst y]) @@ -538,8 +553,6 @@   Left expr -> Expr $ Ast'Enumeral $ Ast.Enumeral "Left" $ Just $ Map.fromList [("left", toAst expr)]   Right expr -> Expr $ Ast'Enumeral $ Ast.Enumeral "Right" $ Just $ Map.fromList [("right", toAst expr)] ---- tuple2   :: (HasType t1, HasType t2)   => Expr t1 -> Expr t2@@ -1214,6 +1227,15 @@  (-<) :: ToArgs args => Expr (Fn (args -> a)) -> args -> Expr a f -< x = call f x++mapLeft :: Expr (Fn ((Expr (Fn (Expr a -> b)), Expr (Either a c)) -> Either b c))+mapLeft = Expr (Ast'Ref $ Ast.Ref "mapLeft")++mapRight :: Expr (Fn ((Expr (Fn (Expr a -> b)), Expr (Either c a)) -> Either c b))+mapRight = Expr (Ast'Ref $ Ast.Ref "mapLeft")++mapOption :: Expr (Fn ((Expr (Fn (Expr a -> b)), Expr (Maybe a)) -> Maybe b))+mapOption = Expr (Ast'Ref $ Ast.Ref "mapOption")  mapList :: Expr (Fn ((Expr (Fn (Expr a -> b)), Expr [a]) -> [b])) mapList = Expr (Ast'Ref $ Ast.Ref "mapList")

@@ -8,8 +8,11 @@   , UnWrap(..)   , UnStruct(..)   , If(..)+  , Iflet(..)   , Get(..)   , Define(..)+  , Match(..)+  , MatchCase(..)   , Lambda(..)   , Fn(..)   , List(..)@@ -109,7 +112,10 @@   | Expr'UnVal (UnVal m)   | Expr'Val Val   | Expr'If (If m)+  | Expr'Iflet (Iflet m)   | Expr'Get (Get m)+  | Expr'Set (Set m)+  | Expr'Match (Match m)   | Expr'Define (Define m)   | Expr'Lambda (Lambda m)   | Expr'List (List m)@@ -150,11 +156,34 @@   , false :: Expr m   } deriving (Show, Eq) +data Iflet m = Iflet+  { symbol :: Symbol+  , option :: Expr m+  , some :: Expr m+  , none :: Expr m+  } deriving (Show, Eq)+ data Get m = Get   { path :: [Text]   , expr :: Expr m   } deriving (Show, Eq) +data Set m = Set+  { path :: [Text]+  , src :: Expr m+  , dest :: Expr m+  } deriving (Show, Eq)++data MatchCase m+  = MatchCase'Tag (Expr m)+  | MatchCase'Members Symbol (Expr m)+  deriving (Show, Eq)++data Match m = Match+  { enumeral :: Expr m+  , cases :: Map EnumeralName (MatchCase m)+  } deriving (Show, Eq)+ data Define m = Define   { var :: Symbol   , expr :: Expr m@@ -236,8 +265,11 @@ fromAst = \case   Ast'Ref Ast.Ref{symbol} -> Expr'Ref $ Ref symbol   Ast'If Ast.If{cond,true,false} -> Expr'If $ If (fromAst cond) (fromAst true) (fromAst false)+  Ast'Iflet Ast.Iflet{symbol, option, some, none} -> Expr'Iflet $ Iflet symbol (fromAst option) (fromAst some) (fromAst none)   Ast'Get Ast.Get{path,val} -> Expr'Get $ Get path (fromAst val)+  Ast'Set Ast.Set{path,src,dest} -> Expr'Set $ Set path (fromAst src) (fromAst dest)   Ast'Define Ast.Define{var,expr} -> Expr'Define $ Define var (fromAst expr)+  Ast'Match Ast.Match{enumeral,cases} -> Expr'Match $ Match (fromAst enumeral) (fromAstMatchCases cases)   Ast'Lambda Ast.Lambda{args,expr} -> Expr'Lambda $ Lambda args (fromAst expr)   Ast'List Ast.List{list} -> Expr'List $ List $ map fromAst list   Ast'Tuple Ast.Tuple{tuple} -> Expr'Tuple $ Tuple $ map fromAst tuple@@ -252,6 +284,12 @@   Ast'Wrap Ast.Wrap{w} -> Expr'UnVal $ UnVal'UnWrap $ UnWrap (fromAst w)   Ast'Const c -> Expr'UnVal $ UnVal'Const c +fromAstMatchCases :: Monad m => [Ast.MatchCase] -> Map EnumeralName (MatchCase m)+fromAstMatchCases = Map.fromList . map cvt+  where+    cvt (Ast.MatchCase'Tag name ast) = (name, MatchCase'Tag (fromAst ast))+    cvt (Ast.MatchCase'Members name sym ast) = (name, MatchCase'Members sym (fromAst ast))+ --  addEnvToEnv :: (RuntimeThrower m, Ord k, MonadIO m) => Maybe Int -> Map k a -> IORef (Map k a) -> m (IORef (Map k a))@@ -271,6 +309,13 @@     Just limit -> when (Map.size env' > limit) $ runtimeThrow RuntimeError'VariableLimit   liftIO $ writeIORef envRef env' +addVarToScope :: (MonadIO m, RuntimeThrower m) => IORef (Env m) -> Symbol -> Expr m -> Eval m ()+addVarToScope envRef var expr = do+  env <- liftIO $ readIORef envRef+  ref <- liftIO $ newIORef expr+  limit <- variableLimit <$> asks limits+  addVarToEnv limit envRef var ref env+ varLookup :: (MonadIO m, RuntimeThrower m) => Map Symbol (IORef a) -> Symbol -> m a varLookup env symbol@(Symbol s) = case Map.lookup symbol env of   Nothing -> runtimeThrow $ RuntimeError'UnknownVariable s@@ -282,10 +327,13 @@ eval expr envRef = case expr of   Expr'Ref atom -> evalRef atom envRef   Expr'If if' -> evalIf if' envRef+  Expr'Iflet iflet -> evalIflet iflet envRef   Expr'UnVal unVal -> evalUnVal unVal envRef   Expr'Val val -> return $ Expr'Val val   Expr'Get get -> evalGet get envRef+  Expr'Set set -> evalSet set envRef   Expr'Define define -> evalDefine define envRef+  Expr'Match match -> evalMatch match envRef   Expr'Lambda lambda -> evalLambda lambda envRef   Expr'Fn _ -> return expr -- throw error?   Expr'List list -> evalList list envRef@@ -338,6 +386,18 @@       eval (if cond' then true else false) envRef''     _ -> runtimeThrow RuntimeError'IncompatibleType +evalIflet :: (MonadIO m, RuntimeThrower m) => Iflet m -> IORef (Env m) -> Eval m (Expr m)+evalIflet Iflet{symbol, option, some, none} envRef = do+  tickExpr+  envRef' <- liftIO $ newIORef =<< readIORef envRef+  option' <- eval option envRef'+  case option' of+    Expr'Val (Val'Const Const'Null) -> eval none envRef'+    some' -> do+      envRef'' <- liftIO $ newIORef =<< readIORef envRef+      addVarToScope envRef'' symbol some'+      eval some envRef''+ evalGet :: (MonadIO m, RuntimeThrower m) => Get m -> IORef (Env m) -> Eval m (Expr m) evalGet Get{path,expr} envRef = do   tickExpr@@ -364,16 +424,71 @@       Just member -> getter path (Expr'Val member) getterApiVal _ _ = runtimeThrow RuntimeError'IncompatibleType +evalSet :: (MonadIO m, RuntimeThrower m) => Set m -> IORef (Env m) -> Eval m (Expr m)+evalSet Set{path,src,dest} envRef = do+  tickExpr+  dest' <- eval dest envRef+  src' <- eval src envRef+  setter path src' dest'++setter :: (MonadIO m, RuntimeThrower m) => [Text] -> Expr m -> Expr m -> Eval m (Expr m)+setter [] src _ = return src+setter path src dest =+  case dest of+    Expr'Val destVal -> case destVal of+      Val'ApiVal destApiVal -> setterApiVal path src destApiVal+      _ -> runtimeThrow RuntimeError'IncompatibleType+    _ -> runtimeThrow RuntimeError'IncompatibleType++setterApiVal :: (MonadIO m, RuntimeThrower m) => [Text] -> Expr m -> ApiVal -> Eval m (Expr m)+setterApiVal (mName:path) src (ApiVal'Struct Struct{m}) =+  case Map.lookup (MemberName mName) m of+    Nothing -> runtimeThrow RuntimeError'IncompatibleType+    Just member -> do+      exprMember' <- setter path src (Expr'Val member)+      case exprMember' of+        Expr'Val member' -> return . Expr'Val . Val'ApiVal . ApiVal'Struct . Struct $+          Map.insert (MemberName mName) member' m+        _ -> runtimeThrow RuntimeError'IncompatibleType -- Needs a Val+setterApiVal (mName:path) src (ApiVal'Enumeral Enumeral{tag, m})+  | mName == "tag" = runtimeThrow RuntimeError'IncompatibleType+  | otherwise = case m of+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+      Just members -> case Map.lookup (MemberName mName) members of+        Nothing -> runtimeThrow RuntimeError'IncompatibleType+        Just member -> do+          exprMember' <- setter path src (Expr'Val member)+          case exprMember' of+            Expr'Val member' -> return . Expr'Val . Val'ApiVal . ApiVal'Enumeral $+              Enumeral { tag = tag, m = Just $ Map.insert (MemberName mName) member' members }+            _ -> runtimeThrow RuntimeError'IncompatibleType -- Needs a Val+setterApiVal _ _ _ = runtimeThrow RuntimeError'IncompatibleType+ evalDefine :: (MonadIO m, RuntimeThrower m) => Define m -> IORef (Env m) -> Eval m (Expr m) evalDefine Define{var, expr} envRef = do   tickExpr   expr' <- eval expr envRef-  env <- liftIO $ readIORef envRef-  ref <- liftIO $ newIORef expr'-  limit <- variableLimit <$> asks limits-  addVarToEnv limit envRef var ref env+  addVarToScope envRef var expr'   return expr' +evalMatch :: (MonadIO m, RuntimeThrower m) => Match m -> IORef (Env m) -> Eval m (Expr m)+evalMatch Match{enumeral, cases} envRef = do+  tickExpr+  envRef' <- liftIO $ newIORef =<< readIORef envRef+  enumeral' <- eval enumeral envRef'+  case enumeral' of+    Expr'Val (Val'ApiVal (ApiVal'Enumeral e)) -> case e of+      Enumeral name members -> case Map.lookup name cases of+        Nothing -> runtimeThrow RuntimeError'MissingMatchCase+        Just matchCase -> case (matchCase, members) of+          (MatchCase'Tag expr, Nothing) -> eval expr envRef+          (MatchCase'Members var expr, Just _) -> do+            envRef'' <- liftIO $ newIORef =<< readIORef envRef+            addVarToScope envRef'' var enumeral'+            eval expr envRef''+          _ -> runtimeThrow RuntimeError'IncompatibleType -- Should or should have members. Incompatible Val?+    _ -> runtimeThrow RuntimeError'IncompatibleType -- Some enumeral, Incompatible Val?+ evalLambda :: (MonadIO m, RuntimeThrower m) => Lambda m -> IORef (Env m) -> Eval m (Expr m) evalLambda Lambda{params, expr} envRef = do   tickLambda@@ -471,8 +586,14 @@  emptyEnv :: RuntimeThrower m => IO (IORef (Env m)) emptyEnv = do+  noT <- newIORef notExpr+   eq <- newIORef eqExpr   neq <- newIORef neqExpr+  lt <- newIORef ltExpr+  lte <- newIORef lteExpr+  gt <- newIORef gtExpr+  gte <- newIORef gteExpr   concat' <- newIORef concatExpr    addI8 <- newIORef $ i8Expr (+)@@ -525,9 +646,20 @@   filterList <- newIORef filterListExpr   reduceList <- newIORef reduceListExpr +  mapOption <- newIORef mapOptionExpr++  mapLeft <- newIORef mapLeftExpr+  mapRight <- newIORef mapRightExpr+   newIORef $ Map.fromList-    [ ("eq", eq)+    [ ("not",noT)++    , ("eq", eq)     , ("neq", neq)+    , ("lt", lt)+    , ("lte", lte)+    , ("gt", gt)+    , ("gte", gte)      , ("addI8", addI8)     , ("addI16", addI16)@@ -576,12 +708,59 @@     , ("concat", concat')     , ("tuple", tuple) +    , ("mapOption", mapOption)+     , ("mapList", mapList)     , ("filterList", filterList)     , ("reduceList", reduceList) +    , ("mapLeft", mapLeft)+    , ("mapRight", mapRight)     ] +mapRightExpr :: RuntimeThrower m => Expr m+mapRightExpr = Expr'Fn . Fn $ \args ->+  case args of+    (_:[]) -> runtimeThrow RuntimeError'TooFewArguments+    [Expr'Fn (Fn f), expr@(Expr'Val (Val'ApiVal (ApiVal'Enumeral Enumeral{tag,m})))] -> case tag of+      "Right" -> case m >>= Map.lookup "right" of+        Nothing -> runtimeThrow RuntimeError'IncompatibleType -- Not an Either'Left+        Just _ -> do+          left <- f [expr]+          case left of+            Expr'Val v -> return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral tag (Map.insert "right" v <$> m)+            _ -> runtimeThrow RuntimeError'IncompatibleType -- Should be a Val+      "Left" -> return expr+      _ -> runtimeThrow RuntimeError'IncompatibleType -- Not an Either+    (_:_:[]) -> runtimeThrow RuntimeError'IncompatibleType+    _ -> runtimeThrow RuntimeError'TooManyArguments++mapLeftExpr :: RuntimeThrower m => Expr m+mapLeftExpr = Expr'Fn . Fn $ \args ->+  case args of+    (_:[]) -> runtimeThrow RuntimeError'TooFewArguments+    [Expr'Fn (Fn f), expr@(Expr'Val (Val'ApiVal (ApiVal'Enumeral Enumeral{tag,m})))] -> case tag of+      "Left" -> case m >>= Map.lookup "left" of+        Nothing -> runtimeThrow RuntimeError'IncompatibleType -- Not an Either'Left+        Just _ -> do+          left <- f [expr]+          case left of+            Expr'Val v -> return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral tag (Map.insert "left" v <$> m)+            _ -> runtimeThrow RuntimeError'IncompatibleType -- Should be a Val+      "Right" -> return expr+      _ -> runtimeThrow RuntimeError'IncompatibleType -- Not an Either+    (_:_:[]) -> runtimeThrow RuntimeError'IncompatibleType+    _ -> runtimeThrow RuntimeError'TooManyArguments++mapOptionExpr :: RuntimeThrower m => Expr m+mapOptionExpr = Expr'Fn . Fn $ \args ->+  case args of+    (_:[]) -> runtimeThrow RuntimeError'TooFewArguments+    [Expr'Fn _, Expr'Val (Val'Const Const'Null)] -> return $ Expr'Val (Val'Const Const'Null)+    [Expr'Fn (Fn f), expr] -> f [expr]+    (_:_:[]) -> runtimeThrow RuntimeError'IncompatibleType+    _ -> runtimeThrow RuntimeError'TooManyArguments+ mapListExpr :: RuntimeThrower m => Expr m mapListExpr = Expr'Fn . Fn $ \args ->   case args of@@ -812,7 +991,7 @@   -> Expr m boolExpr num i8 i16 i32 i64 u8 u16 u32 u64 val = Expr'Fn . Fn $ \args ->   case args of-    (_:[]) -> runtimeThrow RuntimeError'TooManyArguments+    (_:[]) -> runtimeThrow RuntimeError'TooFewArguments     [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Const (Const'Number y))] -> toExpr $ x `num` y      [Expr'Val (Val'Prim (Prim'I8 x)), Expr'Val (Val'Prim (Prim'I8 y))] -> toExpr $ x `i8` y@@ -886,11 +1065,118 @@     where       toExpr v = return $ Expr'Val (toVal v) +numExpr :: (RuntimeThrower m, ToVal a)+  => (Scientific -> Scientific -> a)+  -> (Int8 -> Int8 -> a)+  -> (Int16 -> Int16 -> a)+  -> (Int32 -> Int32 -> a)+  -> (Int64 -> Int64 -> a)+  -> (Word8 -> Word8 -> a)+  -> (Word16 -> Word16 -> a)+  -> (Word32 -> Word32 -> a)+  -> (Word64 -> Word64 -> a)+  -> Expr m+numExpr num i8 i16 i32 i64 u8 u16 u32 u64 = Expr'Fn . Fn $ \args ->+  case args of+    (_:[]) -> runtimeThrow RuntimeError'TooFewArguments+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Const (Const'Number y))] -> toExpr $ x `num` y++    [Expr'Val (Val'Prim (Prim'I8 x)), Expr'Val (Val'Prim (Prim'I8 y))] -> toExpr $ x `i8` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'I8 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `i8` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'I8 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `i8` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'I16 x)), Expr'Val (Val'Prim (Prim'I16 y))] -> toExpr $ x `i16` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'I16 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `i16` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'I16 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `i16` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'I32 x)), Expr'Val (Val'Prim (Prim'I32 y))] -> toExpr $ x `i32` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'I32 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `i32` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'I32 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `i32` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'I64 x)), Expr'Val (Val'Prim (Prim'I64 y))] -> toExpr $ x `i64` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'I64 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `i64` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'I64 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `i64` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'U8 x)), Expr'Val (Val'Prim (Prim'U8 y))] -> toExpr $ x `u8` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'U8 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `u8` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'U8 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `u8` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'U16 x)), Expr'Val (Val'Prim (Prim'U16 y))] -> toExpr $ x `u16` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'U16 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `u16` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'U16 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `u16` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'U32 x)), Expr'Val (Val'Prim (Prim'U32 y))] -> toExpr $ x `u32` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'U32 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `u32` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'U32 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `u32` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    [Expr'Val (Val'Prim (Prim'U64 x)), Expr'Val (Val'Prim (Prim'U64 y))] -> toExpr $ x `u64` y+    [Expr'Val (Val'Const (Const'Number x)), Expr'Val (Val'Prim (Prim'U64 y))] -> case toBoundedInteger x of+      Just x' -> toExpr $ x' `u64` y+      Nothing -> runtimeThrow RuntimeError'IncompatibleType+    [Expr'Val (Val'Prim (Prim'U64 x)), Expr'Val (Val'Const (Const'Number y))] -> case toBoundedInteger y of+      Just y' -> toExpr $ x `u64` y'+      Nothing -> runtimeThrow RuntimeError'IncompatibleType++    (_:_:[]) -> runtimeThrow RuntimeError'IncompatibleType+    _ -> runtimeThrow RuntimeError'TooManyArguments+    where+      toExpr v = return $ Expr'Val (toVal v)++notExpr :: RuntimeThrower m => Expr m+notExpr = Expr'Fn . Fn $ \args ->+  case args of+    [] -> runtimeThrow RuntimeError'TooFewArguments+    [Expr'Val (Val'Const (Const'Bool x))] -> toExpr $ not x+    [Expr'Val (Val'Prim (Prim'Bool x))] -> toExpr $ not x+    _ -> runtimeThrow RuntimeError'TooManyArguments+  where+    toExpr v = return $ Expr'Val (toVal v)+ eqExpr :: RuntimeThrower m => Expr m eqExpr = boolExpr (==) (==) (==) (==) (==) (==) (==) (==) (==) (==)  neqExpr :: RuntimeThrower m => Expr m neqExpr = boolExpr (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=) (/=)++ltExpr :: RuntimeThrower m => Expr m+ltExpr = numExpr (<) (<) (<) (<) (<) (<) (<) (<) (<)++lteExpr :: RuntimeThrower m => Expr m+lteExpr = numExpr (<=) (<=) (<=) (<=) (<=) (<=) (<=) (<=) (<=)++gtExpr :: RuntimeThrower m => Expr m+gtExpr = numExpr (>) (>) (>) (>) (>) (>) (>) (>) (>)++gteExpr :: RuntimeThrower m => Expr m+gteExpr = numExpr (>=) (>=) (>=) (>=) (>=) (>=) (>=) (>=) (>=)  concatExpr :: RuntimeThrower m => Expr m concatExpr = Expr'Fn . Fn $ \args ->

@@ -1,6 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Colorless.ServiceThrower   ( ServiceThrower(..)+  , ThrownValue(..)   ) where  import Control.Exception.Safe@@ -9,11 +10,14 @@  import qualified Colorless.Server.Exchange as Server +newtype ThrownValue = ThrownValue { unThrownValue :: Value }+  deriving (Show, Eq, Typeable)+ class MonadThrow m => ServiceThrower m where   serviceThrow :: Value -> m a-  serviceThrow err = throw err+  serviceThrow err = throw (ThrownValue err) -instance Exception Value+instance Exception ThrownValue  instance MonadThrow m => ServiceThrower (ExceptT Server.Response m) where   serviceThrow = throwError . Server.Response'Error . Server.ResponseError'Service

@@ -73,6 +73,7 @@   | RuntimeError'LangExprLimit Int   | RuntimeError'UnknownVariable Text   | RuntimeError'IncompatibleType+  | RuntimeError'MissingMatchCase   | RuntimeError'TooFewArguments   | RuntimeError'TooManyArguments   | RuntimeError'NoApiVersion@@ -99,6 +100,7 @@     RuntimeError'LangServiceCallLimit l -> object [ "tag" .= String "LangServiceCallLimit", "limit" .= l ]     RuntimeError'UnknownVariable m -> object [ "tag" .= String "UnknownVariable", "name" .= m ]     RuntimeError'IncompatibleType -> e "IncompatibleType"+    RuntimeError'MissingMatchCase -> e "MissingMatchCase"     RuntimeError'TooFewArguments -> e "TooFewArguments"     RuntimeError'TooManyArguments -> e "TooManyArguments"     RuntimeError'NoApiVersion -> e "NoApiVersion"@@ -128,6 +130,7 @@       "LangServiceCallLimit" -> RuntimeError'LangServiceCallLimit <$> o .: "limit"       "UnknownVariable" -> RuntimeError'UnknownVariable <$> o .: "name"       "IncompatibleType" -> pure RuntimeError'IncompatibleType+      "MissingMatchCase" -> pure RuntimeError'MissingMatchCase       "TooFewArguments" -> pure RuntimeError'TooFewArguments       "TooManyArguments" -> pure RuntimeError'TooManyArguments       "NoApiVersion" -> pure RuntimeError'NoApiVersion

@@ -1,5 +1,5 @@ name: colorless-version: '2.2.18'+version: '2.2.19' category: Web synopsis: Colorless | The Programmatic IDL description: Colorless | The Programmatic IDL