Split language into new module

src/Data/Language/Ruby.hs

@@ -0,0 +1,137 @@
+{-# LANGUAGE DuplicateRecordFields, OverloadedLists #-}
+{-# OPTIONS_GHC -Wall #-}
+module Data.Language.Ruby
+  ( Args(..)
+  , Block(..)
+  , Definition(..)
+  , Function(..)
+  , Module(..)
+  , Name(..)
+  , Send(..)
+  ) where
+
+import Data.Aeson (parseJSON, Value(String, Null, Array), withArray)
+import Frelude
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.Vector as Vector
+
+kebabCase :: String -> String
+kebabCase = Aeson.camelTo2 '-'
+
+aesonOptions :: Aeson.Options
+aesonOptions = Aeson.defaultOptions
+  { Aeson.sumEncoding = Aeson.ObjectWithSingleField
+  , Aeson.constructorTagModifier = kebabCase
+  }
+
+newtype Block = Block [Definition]
+
+deriving stock instance Show Block
+deriving stock instance Generic Block
+instance ToJSON Block where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+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)
+
+data Definition
+  = DefModule Module
+  | DefFunction Function
+  | DefSend Send
+
+deriving stock instance Show Definition
+deriving stock instance Generic Definition
+instance ToJSON Definition where
+  toEncoding = Aeson.genericToEncoding opts
+    where
+    opts = opts { Aeson.constructorTagModifier = go }
+    go = \case
+      "DefModule" -> "module"
+      "DefFunction" -> "function"
+      "DefSend" -> "send"
+      x -> x
+
+instance FromJSON Definition where
+  parseJSON val
+    =   (DefModule <$> parseJSON val)
+    <|> (DefFunction <$> parseJSON val)
+    <|> (DefSend <$> parseJSON val)
+
+data Send = Send
+  { args :: Args
+  , name :: Name
+  }
+
+deriving stock instance Show Send
+deriving stock instance Generic Send
+instance ToJSON Send where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+instance FromJSON Send where
+  parseJSON = withArray "Send" $ \ as -> case Vector.toList as of
+    (String "send" : _ : name : args)
+      ->  Send
+      <$> parseJSON (Array $ Vector.fromList args)
+      <*> parseJSON name
+    _ -> empty
+
+data Module = Module
+  { name :: Name
+  , block :: Block
+  }
+
+deriving stock instance Show Module
+deriving stock instance Generic Module
+instance ToJSON Module where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+instance FromJSON Module where
+  parseJSON = withArray "Module" $ \case
+    [String "module", name, block]
+      ->  Module
+      <$> parseJSON name
+      <*> parseMaybeBlock block
+    _ -> empty
+
+parseMaybeBlock :: Value -> Aeson.Parser Block
+parseMaybeBlock = \case
+  Null -> pure (Block mempty)
+  x -> parseJSON x
+
+data Function = Function
+  { name :: Name
+  , args :: Args
+  , block :: Block
+  }
+
+deriving stock instance Show Function
+deriving stock instance Generic Function
+instance ToJSON Function where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+newtype Args = Args Value
+
+deriving stock instance Show Args
+deriving stock instance Generic Args
+instance ToJSON Args where
+  toEncoding = Aeson.genericToEncoding aesonOptions
+
+instance FromJSON Args where
+  parseJSON = pure . Args
+
+instance FromJSON Function where
+  parseJSON = withArray "Function" $ \case
+    [String "def", name, args, block]
+      ->  Function
+      <$> parseJSON name
+      <*> parseJSON args
+      <*> parseMaybeBlock block
+    _ -> empty
+
+newtype Name = Name Value
+
+deriving stock instance Show Name
+deriving newtype instance ToJSON Name
+deriving newtype instance FromJSON Name

src/Rubyhs.hs

@@ -2,125 +2,19 @@
 {-# OPTIONS_GHC -Wall #-}
 module Rubyhs (main) where
 
-import Frelude
-import System.Process
-import System.Environment
-import Data.Foldable (traverse_)
-import Data.Aeson (parseJSON, Value(String), withArray, eitherDecode, encode)
-import Data.Aeson.Types
-import Data.ByteString.Lazy (ByteString)
-import qualified Data.ByteString.Lazy.Char8 as ByteString
 import Control.Monad.Fail (MonadFail)
-import qualified Data.Vector as Vector
+import Data.Aeson (eitherDecode, encode)
+import Data.ByteString.Lazy (ByteString)
+import Data.Foldable (traverse_)
+import Data.Language.Ruby (Block)
+import Frelude
+import System.Environment (getArgs)
+import System.Process (readProcess)
+import qualified Data.ByteString.Lazy.Char8 as ByteString
 
 main :: IO ()
 main = getArgs >>= traverse_ run
 
-kebabCase :: String -> String
-kebabCase = camelTo2 '-'
-
-newtype Block = Block [Definition]
-
-opts :: Options
-opts = defaultOptions { sumEncoding = ObjectWithSingleField, constructorTagModifier = kebabCase }
-
-deriving stock instance Show Block
-deriving stock instance Generic Block
-instance ToJSON Block where
-  toEncoding = genericToEncoding opts
-
-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)
-
-data Definition = DefModule Module | DefFunction Function | DefSend Send
-
-deriving stock instance Show Definition
-deriving stock instance Generic Definition
-instance ToJSON Definition where
-  toEncoding = genericToEncoding ( opts { constructorTagModifier = go })
-    where
-    go = \case
-      "DefModule" -> "module"
-      "DefFunction" -> "function"
-      "DefSend" -> "send"
-      x -> x
-
-instance FromJSON Definition where
-  parseJSON val
-    =   (DefModule <$> parseJSON val)
-    <|> (DefFunction <$> parseJSON val)
-    <|> (DefSend <$> parseJSON val)
-
-data Send = Send
-  { args :: Args
-  , name :: Name
-  }
-
-
-deriving stock instance Show Send
-deriving stock instance Generic Send
-instance ToJSON Send where
-  toEncoding = genericToEncoding opts
-
-instance FromJSON Send where
-  parseJSON = withArray "Send" $ \ as -> case Vector.toList as of
-    (String "send" : _ : name : args) -> Send <$> parseJSON (Array $ Vector.fromList args) <*> parseJSON name
-    _ -> empty
-
-data Module = Module
-  { name :: Name
-  , block :: Block
-  }
-
-deriving stock instance Show Module
-deriving stock instance Generic Module
-instance ToJSON Module where
-  toEncoding = genericToEncoding opts
-
-instance FromJSON Module where
-  parseJSON = withArray "Module" $ \case
-    [String "module", name, block] -> Module <$> parseJSON name <*> parseMaybeBlock block
-    _ -> empty
-
-parseMaybeBlock :: Value -> Parser Block
-parseMaybeBlock = \case
-  Null -> pure (Block mempty)
-  x -> parseJSON x
-
-data Function = Function
-  { name :: Name
-  , args :: Args
-  , block :: Block
-  }
-
-deriving stock instance Show Function
-deriving stock instance Generic Function
-instance ToJSON Function where
-  toEncoding = genericToEncoding opts
-
-newtype Args = Args Value
-
-deriving stock instance Show Args
-deriving stock instance Generic Args
-instance ToJSON Args where
-  toEncoding = genericToEncoding opts
-
-instance FromJSON Args where
-  parseJSON = pure . Args
-
-instance FromJSON Function where
-  parseJSON = withArray "Function" $ \case
-    [String "def", name, args, block] -> Function <$> parseJSON name <*> parseJSON args <*> parseMaybeBlock block
-    _ -> empty
-
-newtype Name = Name Value
-
-deriving stock instance Show Name
-deriving newtype instance ToJSON Name
-deriving newtype instance FromJSON Name
-
 run :: FilePath -> IO ()
 run p = do
   json <- runParser p