diff --git a/src/Data/Language/Ruby.hs b/src/Data/Language/Ruby.hs index b1671a4..4b87688 100644 --- a/src/Data/Language/Ruby.hs +++ b/src/Data/Language/Ruby.hs @@ -35,16 +35,21 @@ deriving stock instance Eq Block deriving stock instance Generic Block instance ToJSON Block where toEncoding = Aeson.genericToEncoding aesonOptions +deriving newtype instance Semigroup Block +deriving newtype instance Monoid Block instance FromJSON Block where parseJSON = withArray "Block" $ \as -> case Vector.toList as of (String "begin":xs) -> Block <$> traverse parseJSON xs _ -> Block . pure <$> parseJSON (Array as) +-- Should be 'expression' data Definition = DefModule Module | DefFunction Function | DefSend Send + | DefRBlock RBlock + | DefAnything Anything deriving stock instance Show Definition deriving stock instance Ord Definition @@ -55,16 +60,54 @@ instance ToJSON Definition where where opts = aesonOptions { Aeson.constructorTagModifier = go } go = \case - "DefModule" -> "module" + "DefModule" -> "module" "DefFunction" -> "function" - "DefSend" -> "send" - x -> x + "DefSend" -> "send" + "DefRBlock" -> "block" + x -> x instance FromJSON Definition where parseJSON v - = (DefModule <$> parseJSON v) + = (DefModule <$> parseJSON v) <|> (DefFunction <$> parseJSON v) - <|> (DefSend <$> parseJSON v) + <|> (DefSend <$> parseJSON v) + <|> (DefRBlock <$> parseJSON v) + <|> (DefAnything <$> parseJSON v) + +newtype Anything = Anything Value + +deriving stock instance Show Anything +instance Ord Anything where + compare = coerce compareValue +deriving stock instance Eq Anything +deriving stock instance Generic Anything +instance ToJSON Anything where + toEncoding = Aeson.genericToEncoding aesonOptions +deriving newtype instance FromJSON Anything + +-- f do |x| +-- expr +-- end +data RBlock = RBlock + { send :: Send + , args :: Args + , block :: Block + } + +deriving stock instance Show RBlock +deriving stock instance Ord RBlock +deriving stock instance Eq RBlock +deriving stock instance Generic RBlock +instance ToJSON RBlock where + toEncoding = Aeson.genericToEncoding aesonOptions +instance FromJSON RBlock where + parseJSON = withArray "RBlock" $ \as -> case Vector.toList as of + (String "block":send:args:block:[]) + -> RBlock + <$> parseJSON send + <*> parseJSON args + <*> parseJSON block + _ -> empty newtype Namespace = Namespace [Name] @@ -81,7 +124,7 @@ instance FromJSON Namespace where parseJSON = \case Null -> pure mempty Array [String "const", namespace, String name] -> (<> Namespace [Name $ String name]) <$> parseJSON namespace - x -> error $ show x + _ -> empty data Send = Send { args :: Args @@ -122,12 +165,16 @@ instance FromJSON Module where [String "module", name, block] -> Module <$> parseJSON name - <*> parseMaybeBlock block + <*> parseMaybe block + [String "class", name, _, block] + -> Module + <$> parseJSON name + <*> parseMaybe block _ -> empty -parseMaybeBlock :: Value -> Aeson.Parser Block -parseMaybeBlock = \case - Null -> pure (Block mempty) +parseMaybe :: FromJSON m => Monoid m => Value -> Aeson.Parser m +parseMaybe = \case + Null -> pure mempty x -> parseJSON x data Function = Function @@ -143,7 +190,7 @@ deriving stock instance Generic Function instance ToJSON Function where toEncoding = Aeson.genericToEncoding aesonOptions -newtype Args = Args Value +newtype Args = Args Anything deriving stock instance Show Args instance Ord Args where @@ -154,7 +201,7 @@ instance ToJSON Args where toEncoding = Aeson.genericToEncoding aesonOptions instance FromJSON Args where - parseJSON = pure . Args + parseJSON = pure . coerce instance FromJSON Function where parseJSON = withArray "Function" $ \case @@ -162,7 +209,7 @@ instance FromJSON Function where -> Function <$> parseJSON name <*> parseJSON args - <*> parseMaybeBlock block + <*> parseMaybe block _ -> empty newtype Name = Name Value diff --git a/src/Rubyhs.hs b/src/Rubyhs.hs index 10a081e..8cd4deb 100644 --- a/src/Rubyhs.hs +++ b/src/Rubyhs.hs @@ -20,7 +20,7 @@ run :: FilePath -> IO () run p = do json <- runParser p block <- decodeFail @_ @Block $ ByteString.pack json - -- ByteString.putStrLn $ encode block + ByteString.putStrLn $ encode block ByteString.putStrLn $ encode $ references block decodeFail :: MonadFail m => FromJSON a => ByteString -> m a diff --git a/src/Rubyhs/References.hs b/src/Rubyhs/References.hs index 716d2d6..938ca38 100644 --- a/src/Rubyhs/References.hs +++ b/src/Rubyhs/References.hs @@ -160,6 +160,9 @@ instance References Definition where DefModule m -> entries m DefFunction f -> entries f DefSend s -> entries s + -- TODO: + DefRBlock{} -> pure () + DefAnything{} -> pure () instance References Module where entries Module{name, block} = do