{-# 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 "print-ast" <> Options.help "Print AST and exit" getCommand :: IO Command getCommand = Options.execParser opts where opts = Options.info (Options.helper <*> command) ( Options.fullDesc <> Options.progDesc "Static analysis of Ruby" <> Options.header "rubyhs - Static analysis of Ruby" ) 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