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.Process (readProcess)
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Rubyhs.References (references)
import Options.Applicative (Parser)
import qualified Options.Applicative as Options
import System.IO.Temp (withSystemTempFile)
import System.IO (hFlush)

main :: IO ()
main = do
  Command{targets, printAST} <- getCommand
  blocks <- decodeInput @Block targets
  if printAST
  then traverse_ @[] putEncoded blocks
  else traverse_ (putEncoded . references) blocks

-- | Decode from files and mappends the stuff from stdin.
decodeInput :: FromJSON a => [FilePath] -> IO [a]
decodeInput = \case
  [] -> ByteString.getContents >>= fmap pure . decode
  ps -> traverse decodeFile ps

putEncoded :: ToJSON a => a -> IO ()
putEncoded = ByteString.putStrLn . encode

decodeFile :: FromJSON a => FilePath -> IO a
decodeFile = runRubyParseFile >=> decodeFail . ByteString.pack

decode :: FromJSON a => ByteString -> IO a
decode = runRubyParse >=> decodeFail . ByteString.pack

data Command = Command
  { targets  :: [FilePath]
  , printAST :: Bool
  }

command :: Parser Command
command = Command <$> targets <*> printAST
  where
  targets = many (Options.argument Options.str (Options.metavar "TARGET"))
  printAST = Options.switch
    $  Options.long "quiet"
    <> Options.short 'q'
    <> Options.help "Whether to be quiet"

getCommand :: IO Command
getCommand = Options.execParser opts
  where
    opts = Options.info (Options.helper <*> command)
      ( Options.fullDesc
     <> Options.progDesc "Print a greeting for TARGET"
     <> Options.header "hello - a test for optparse-applicative" )

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

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

runRubyParse :: ByteString -> IO String
runRubyParse s = withSystemTempFile "rubyhs" $ \p h -> do
  ByteString.hPut h s
  hFlush h
  runRubyParseFile p

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