colorless 0.0.1 → 0.0.2
raw patch · 8 files changed
+56/−56 lines, 8 files
Files
- colorless.cabal +1/−1
- library/Colorless/Runtime/Ast.hs +8/−8
- library/Colorless/Runtime/Expr.hs +13/−13
- library/Colorless/Runtime/Types.hs +5/−5
- library/Colorless/Runtime/Val.hs +19/−19
- package.yaml +1/−1
- tests/AstSpec.hs +4/−4
- tests/ValSpec.hs +5/−5
colorless.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack name: colorless-version: 0.0.1+version: 0.0.2 synopsis: Colorless description: Colorless category: Web
library/Colorless/Runtime/Ast.hs view
@@ -10,7 +10,7 @@ , List(..) , Begin(..) , FnCall(..)- , Enumerator(..)+ , Enumeral(..) , Struct(..) , Wrap(..) , StructCall(..)@@ -45,7 +45,7 @@ | Ast'StructCall StructCall | Ast'EnumerationCall EnumerationCall | Ast'HollowCall HollowCall- | Ast'Enumerator Enumerator+ | Ast'Enumeral Enumeral | Ast'Struct Struct | Ast'Wrap Wrap | Ast'Const Const@@ -66,7 +66,7 @@ <|> (Ast'WrapCall <$> parseJSON v) <|> (Ast'StructCall <$> parseJSON v) <|> (Ast'HollowCall <$> parseJSON v)- <|> (Ast'Enumerator <$> parseJSON v)+ <|> (Ast'Enumeral <$> parseJSON v) <|> (Ast'Struct <$> parseJSON v) <|> (Ast'Wrap <$> parseJSON v) <|> (Ast'Const <$> parseJSON v)@@ -198,18 +198,18 @@ instance FromJSON HollowCall -data Enumerator = Enumerator- { tag :: EnumeratorName+data Enumeral = Enumeral+ { tag :: EnumeralName , m :: Maybe (Map MemberName Ast) } deriving (Show, Eq, Generic) -instance FromJSON Enumerator where+instance FromJSON Enumeral where parseJSON (Object o) = do tag <- o .: "tag" let tagless = HML.delete "tag" o if HML.size o == 1- then pure $ Enumerator tag Nothing- else Enumerator tag <$> (Just <$> parseJSON (Object tagless))+ then pure $ Enumeral tag Nothing+ else Enumeral tag <$> (Just <$> parseJSON (Object tagless)) parseJSON _ = mzero data Struct = Struct
library/Colorless/Runtime/Expr.hs view
@@ -5,7 +5,7 @@ -- , Ref(..) , UnVal(..)- , UnEnumerator(..)+ , UnEnumeral(..) , UnWrap(..) , UnStruct(..) , If(..)@@ -26,7 +26,7 @@ , ApiVal(..) , Wrap(..) , Struct(..)- , Enumerator(..)+ , Enumeral(..) , ApiCall(..) -- , jsonToExpr@@ -103,7 +103,7 @@ = UnVal'Const Const | UnVal'UnWrap (UnWrap m) | UnVal'UnStruct (UnStruct m)- | UnVal'UnEnumerator (UnEnumerator m)+ | UnVal'UnEnumeral (UnEnumeral m) deriving (Show, Eq) data UnWrap m = UnWrap@@ -114,8 +114,8 @@ { m :: Map MemberName (Expr m) } deriving (Show, Eq) -data UnEnumerator m = UnEnumerator- { tag :: EnumeratorName+data UnEnumeral m = UnEnumeral+ { tag :: EnumeralName , m :: Maybe (Map MemberName (Expr m)) } deriving (Show, Eq) @@ -199,7 +199,7 @@ data ApiCall = ApiCall'Hollow TypeName | ApiCall'Struct TypeName Struct- | ApiCall'Enumeration TypeName Enumerator+ | ApiCall'Enumeration TypeName Enumeral | ApiCall'Wrap TypeName Wrap deriving (Show, Eq) @@ -227,7 +227,7 @@ Ast'HollowCall Ast.HollowCall{n} -> Expr'ApiUnCall $ ApiUnCall'HollowUnCall $ HollowUnCall n Ast'StructCall Ast.StructCall{n,m} -> Expr'ApiUnCall $ ApiUnCall'StructUnCall $ StructUnCall n (fromAst <$> m) Ast'EnumerationCall Ast.EnumerationCall{n,e} -> Expr'ApiUnCall $ ApiUnCall'EnumerationUnCall $ EnumerationUnCall n (fromAst e)- Ast'Enumerator Ast.Enumerator{tag,m} -> Expr'UnVal $ UnVal'UnEnumerator $ UnEnumerator tag (fmap fromAst <$> m)+ Ast'Enumeral Ast.Enumeral{tag,m} -> Expr'UnVal $ UnVal'UnEnumeral $ UnEnumeral tag (fmap fromAst <$> m) Ast'Struct Ast.Struct{m} -> Expr'UnVal $ UnVal'UnStruct $ UnStruct (fromAst <$> m) Ast'Wrap Ast.Wrap{w} -> Expr'UnVal $ UnVal'UnWrap $ UnWrap (fromAst w) Ast'Const c -> Expr'UnVal $ UnVal'Const c@@ -297,12 +297,12 @@ Expr'Val (Val'Const c) -> return $ Expr'Val $ Val'ApiVal $ ApiVal'Wrap $ Wrap c _ -> runtimeThrow RuntimeError'IncompatibleType - UnVal'UnEnumerator UnEnumerator{tag,m} -> do+ UnVal'UnEnumeral UnEnumeral{tag,m} -> do case m of- Nothing -> return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumerator $ Enumerator tag Nothing+ Nothing -> return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral tag Nothing Just members' -> do members <- mapM (\(name,expr) -> (name,) <$> (forceVal =<< eval expr envRef)) (Map.toList members')- return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumerator $ Enumerator tag (Just $ Map.fromList members)+ return $ Expr'Val $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral tag (Just $ Map.fromList members) evalIf :: (MonadIO m, RuntimeThrower m) => If m -> IORef (Env m) -> Eval m (Expr m) evalIf If{cond, true, false} envRef = do@@ -342,7 +342,7 @@ case Map.lookup (MemberName mName) m of Nothing -> runtimeThrow RuntimeError'IncompatibleType Just member -> getter path (Expr'Val member)-getterApiVal (mName:path) (ApiVal'Enumerator Enumerator{m})+getterApiVal (mName:path) (ApiVal'Enumeral Enumeral{m}) | mName == "tag" = runtimeThrow RuntimeError'IncompatibleType | otherwise = case m >>= Map.lookup (MemberName mName) of Nothing -> runtimeThrow RuntimeError'IncompatibleType@@ -438,7 +438,7 @@ evalEnumerationUnCall EnumerationUnCall{n,e} envRef = do expr <- eval e envRef case expr of- Expr'Val (Val'ApiVal (ApiVal'Enumerator e')) -> Eval . ReaderT $ \cfg ->+ Expr'Val (Val'ApiVal (ApiVal'Enumeral e')) -> Eval . ReaderT $ \cfg -> apiCall cfg $ ApiCall'Enumeration n e' _ -> runtimeThrow RuntimeError'IncompatibleType @@ -673,5 +673,5 @@ parseApiCall ApiParser{hollow, struct, enumeration, wrap} = \case ApiCall'Hollow n -> Map.lookup n hollow ApiCall'Struct n s -> join $ ($ Val'ApiVal (ApiVal'Struct s)) <$> Map.lookup n struct- ApiCall'Enumeration n e -> join $ ($ Val'ApiVal (ApiVal'Enumerator e)) <$> Map.lookup n enumeration+ ApiCall'Enumeration n e -> join $ ($ Val'ApiVal (ApiVal'Enumeral e)) <$> Map.lookup n enumeration ApiCall'Wrap n w -> join $ ($ Val'ApiVal (ApiVal'Wrap w)) <$> Map.lookup n wrap
library/Colorless/Runtime/Types.hs view
@@ -3,8 +3,8 @@ , Type(..) , TypeName(..) , MemberName(..)- , EnumeratorName(..)- , EnumeratorType(..)+ , EnumeralName(..)+ , EnumeralType(..) , EnumerationType(..) , StructType(..) , HollowType(..)@@ -43,18 +43,18 @@ newtype TypeName = TypeName Text deriving (Show, Eq, Ord, FromJSON, IsString) -newtype EnumeratorName = EnumeratorName Text+newtype EnumeralName = EnumeralName Text deriving (Show, Eq, Ord, FromJSON, ToJSON, IsString) newtype MemberName = MemberName Text deriving (Show, Eq, Ord, FromJSON, ToJSON, ToJSONKey, FromJSONKey, IsString) -data EnumeratorType = EnumeratorType+data EnumeralType = EnumeralType { m :: Maybe (Map MemberName Type) } deriving (Show, Eq) data EnumerationType = EnumerationType- { e :: Map EnumeratorName EnumeratorType+ { e :: Map EnumeralName EnumeralType , o :: Type } deriving (Show, Eq)
library/Colorless/Runtime/Val.hs view
@@ -4,7 +4,7 @@ , ApiVal(..) , Wrap(..) , Struct(..)- , Enumerator(..)+ , Enumeral(..) -- , FromVal(..) , ToVal(..)@@ -55,19 +55,19 @@ data ApiVal = ApiVal'Wrap Wrap | ApiVal'Struct Struct- | ApiVal'Enumerator Enumerator+ | ApiVal'Enumeral Enumeral deriving (Show, Eq) instance ToJSON ApiVal where toJSON = \case ApiVal'Wrap w -> toJSON w ApiVal'Struct s -> toJSON s- ApiVal'Enumerator e -> toJSON e+ ApiVal'Enumeral e -> toJSON e instance FromJSON ApiVal where parseJSON v = (ApiVal'Wrap <$> parseJSON v) <|>- (ApiVal'Enumerator <$> parseJSON v) <|>+ (ApiVal'Enumeral <$> parseJSON v) <|> (ApiVal'Struct <$> parseJSON v) data Wrap = Wrap@@ -87,23 +87,23 @@ instance FromJSON Struct where parseJSON v = Struct <$> parseJSON v -data Enumerator = Enumerator- { tag :: EnumeratorName+data Enumeral = Enumeral+ { tag :: EnumeralName , m :: Maybe (Map MemberName Val) } deriving (Show, Eq, Generic) -instance ToJSON Enumerator where- toJSON Enumerator{tag,m} = object $ [ "tag" .= tag ] ++ case m of+instance ToJSON Enumeral where+ toJSON Enumeral{tag,m} = object $ [ "tag" .= tag ] ++ case m of Nothing -> [] Just m' -> concatMap (\(MemberName k,v) -> [ k .= v ]) (Map.toList m') -instance FromJSON Enumerator where+instance FromJSON Enumeral where parseJSON (Object o) = do tag <- o .: "tag" let tagless = HML.delete "tag" o if HML.size o == 1- then pure $ Enumerator tag Nothing- else Enumerator tag <$> (Just <$> parseJSON (Object tagless))+ then pure $ Enumeral tag Nothing+ else Enumeral tag <$> (Just <$> parseJSON (Object tagless)) parseJSON _ = mzero --@@ -160,14 +160,14 @@ toVal d = Val'Const $ Const'Number $ fromFloatDigits d instance ToVal a => ToVal (Maybe a) where- toVal m = Val'ApiVal $ ApiVal'Enumerator $ case m of- Nothing -> Enumerator "None" Nothing- Just s -> Enumerator "Some" (Just $ Map.singleton "some" (toVal s))+ toVal m = Val'ApiVal $ ApiVal'Enumeral $ case m of+ Nothing -> Enumeral "None" Nothing+ Just s -> Enumeral "Some" (Just $ Map.singleton "some" (toVal s)) instance (ToVal a, ToVal b) => ToVal (Either a b) where- toVal m = Val'ApiVal $ ApiVal'Enumerator $ case m of- Left l -> Enumerator "Left" (Just $ Map.singleton "left" (toVal l))- Right r -> Enumerator "Right" (Just $ Map.singleton "right" (toVal r))+ toVal m = Val'ApiVal $ ApiVal'Enumeral $ case m of+ Left l -> Enumeral "Left" (Just $ Map.singleton "left" (toVal l))+ Right r -> Enumeral "Right" (Just $ Map.singleton "right" (toVal r)) instance ToVal a => ToVal [a] where toVal list = Val'List $ map toVal list@@ -256,14 +256,14 @@ fromVal _ = Nothing instance FromVal a => FromVal (Maybe a) where- fromVal (Val'ApiVal (ApiVal'Enumerator (Enumerator tag m))) = case (tag,m) of+ fromVal (Val'ApiVal (ApiVal'Enumeral (Enumeral tag m))) = case (tag,m) of ("Some",Just m') -> fromVal <$> Map.lookup "some" m' ("None",Nothing) -> Just Nothing _ -> Nothing fromVal _ = Nothing instance (FromVal a, FromVal b) => FromVal (Either a b) where- fromVal (Val'ApiVal (ApiVal'Enumerator (Enumerator tag m))) = case (tag,m) of+ fromVal (Val'ApiVal (ApiVal'Enumeral (Enumeral tag m))) = case (tag,m) of ("Left",Just m') -> Map.lookup "left" m' >>= \l -> Left <$> fromVal l ("Right",Just m') -> Map.lookup "right" m' >>= \r -> Right <$> fromVal r _ -> Nothing
package.yaml view
@@ -1,5 +1,5 @@ name: colorless-version: '0.0.1'+version: '0.0.2' category: Web synopsis: Colorless description: Colorless
tests/AstSpec.hs view
@@ -87,7 +87,7 @@ context "EnumerationCall" $ do it "simple" $ shouldBe (parseAst $ object [ "n" .= String "MyEnum", "e" .= object [ "tag" .= String "MyTag" ] ])- (Just $ Ast'EnumerationCall $ EnumerationCall "MyEnum" (Ast'Enumerator $ Enumerator "MyTag" Nothing))+ (Just $ Ast'EnumerationCall $ EnumerationCall "MyEnum" (Ast'Enumeral $ Enumeral "MyTag" Nothing)) context "StructCall" $ do it "simple" $ shouldBe@@ -99,13 +99,13 @@ (parseAst $ object [ "n" .= String "MyCall" ]) (Just $ Ast'HollowCall $ HollowCall "MyCall") - context "Enumerator" $ do+ context "Enumeral" $ do it "simple without members" $ shouldBe (parseAst $ object [ "tag" .= String "MyTag" ])- (Just $ Ast'Enumerator $ Enumerator "MyTag" Nothing)+ (Just $ Ast'Enumeral $ Enumeral "MyTag" Nothing) it "simple with members" $ shouldBe (parseAst $ object [ "tag" .= String "MyTag", "x" .= Bool True ])- (Just $ Ast'Enumerator $ Enumerator "MyTag" (Just $ Map.fromList [("x", Ast'Const $ Const'Bool True)]))+ (Just $ Ast'Enumeral $ Enumeral "MyTag" (Just $ Map.fromList [("x", Ast'Const $ Const'Bool True)])) context "Struct" $ do it "simple" $ shouldBe
tests/ValSpec.hs view
@@ -12,20 +12,20 @@ spec :: Spec spec = do describe "parse basic types from json" $ do- it "Enumerator" $ shouldBe+ it "Enumeral" $ shouldBe (parseMaybe parseJSON $ object [ "tag" .= ("None" :: Text) ])- (Just $ Val'ApiVal $ ApiVal'Enumerator $ Enumerator "None" Nothing)+ (Just $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral "None" Nothing) it "Struct" $ shouldBe (parseMaybe parseJSON $ object [ "x" .= True ]) (Just $ Val'ApiVal $ ApiVal'Struct $ Struct $ Map.fromList [("x", Val'Const $ Const'Bool True)] ) it "Struct" $ shouldBe (parseMaybe parseJSON $ object [ "x" .= object [ "tag" .= ("None" :: Text) ] ])- (Just $ Val'ApiVal $ ApiVal'Struct $ Struct $ Map.fromList [("x", Val'ApiVal $ ApiVal'Enumerator $ Enumerator "None" Nothing)] )+ (Just $ Val'ApiVal $ ApiVal'Struct $ Struct $ Map.fromList [("x", Val'ApiVal $ ApiVal'Enumeral $ Enumeral "None" Nothing)] ) describe "parse types from val" $ do context "Option" $ do it "None" $ shouldBe- (fromVal $ Val'ApiVal $ ApiVal'Enumerator $ Enumerator "None" Nothing)+ (fromVal $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral "None" Nothing) (Just Nothing :: Maybe (Maybe Bool)) it "Some" $ shouldBe- (fromVal $ Val'ApiVal $ ApiVal'Enumerator $ Enumerator "Some" $ Just $ Map.fromList [("some", Val'Const $ Const'Bool $ True)])+ (fromVal $ Val'ApiVal $ ApiVal'Enumeral $ Enumeral "Some" $ Just $ Map.fromList [("some", Val'Const $ Const'Bool $ True)]) (Just (Just True) :: Maybe (Maybe Bool))