rubyhs/src/Rubyhs.hs
2019-10-11 11:08:36 +02:00

47 lines
1.5 KiB
Haskell

{-# 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