rubyhs/src/Rubyhs.hs

{-# LANGUAGE DuplicateRecordFields, OverloadedLists #-}
{-# OPTIONS_GHC -Wall #-}
module Rubyhs (main) where

import Control.Monad.Fail (MonadFail)
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
import Rubyhs.References (references)
import qualified Rubyhs.References as References
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Data.Text.Prettyprint.Doc (layoutCompact)
import Data.HashMap.Strict (HashMap)
import GHC.Exts (fromList, toList)

main :: IO ()
main = getArgs >>= traverse_ run

run :: FilePath -> IO ()
run p = do
  json <- runParser p
  block <- decodeFail @_ @Block $ ByteString.pack json
  ByteString.putStrLn $ encode block
  let References.Env{declarations, applications} = references block
  printEm declarations
  printEm applications
  where
  go (x, y) = (renderStrict $ layoutCompact $ pretty x, y)
  printEm x = ByteString.putStrLn $ encode $ fromList @(HashMap _ _) $ go <$> toList x

decodeFail :: MonadFail m => FromJSON a => ByteString -> m a
decodeFail s = case eitherDecode s of
  Left err -> Frelude.fail err
  Right a -> pure a

runParser :: FilePath -> IO String
runParser p = sh "ruby-parse" ["--emit-json", "--25", p]

sh :: String -> [String] -> IO String
sh cmd args = readProcess cmd args mempty