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