diff --git a/src/Data/Language/Ruby.hs b/src/Data/Language/Ruby.hs index 4bee141..ffec1bd 100644 --- a/src/Data/Language/Ruby.hs +++ b/src/Data/Language/Ruby.hs @@ -2,6 +2,38 @@ {-# OPTIONS_GHC -Wall #-} module Data.Language.Ruby ( module Data.Language.Ruby.AST + , parse + , parseFile ) where +import Data.Aeson (eitherDecode) +import Data.ByteString.Lazy (ByteString) import Data.Language.Ruby.AST +import Frelude +import System.IO (hFlush) +import System.IO.Temp (withSystemTempFile) +import System.Process (readProcess) +import qualified Data.ByteString.Lazy.Char8 as ByteString + +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 a = readProcess cmd a mempty + +parseFile :: FromJSON a => FilePath -> IO a +parseFile = runRubyParseFile >=> decodeFail . ByteString.pack + +parse :: FromJSON a => ByteString -> IO a +parse = runRubyParse >=> decodeFail . ByteString.pack diff --git a/src/Rubyhs.hs b/src/Rubyhs.hs index 99877af..fbeb7cc 100644 --- a/src/Rubyhs.hs +++ b/src/Rubyhs.hs @@ -2,51 +2,42 @@ {-# 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 qualified Rubyhs.References -import Options.Applicative (Parser) -import qualified Options.Applicative as Options -import System.IO.Temp (withSystemTempFile) -import System.IO (hFlush) +import qualified Data.Language.Ruby as Ruby import Data.Tree (Tree(Node), Forest) +import Frelude +import Options.Applicative (Parser) import qualified Data.Aeson as Aeson +import qualified Data.ByteString.Lazy.Char8 as ByteString +import qualified Options.Applicative as Options +import qualified Rubyhs.References main :: IO () main = do Command{targets, printAST} <- getCommand - blocks <- decodeInput @Block targets + blocks <- parseInput @Block targets if printAST then traverse_ @[] putEncoded blocks else do traverse_ (putEncoded . Rubyhs.References.references) blocks - traverse_ (ByteString.putStrLn . encode . toJSONForest . Rubyhs.References.graph) blocks + traverse_ (ByteString.putStrLn . Aeson.encode . toJSONForest . Rubyhs.References.graph) blocks toJSONForest :: Forest Rubyhs.References.Node -> Aeson.Value toJSONForest = Aeson.Object . fromList . fmap go where go (Node x xs) = (Rubyhs.References.prettyContext x, toJSONForest xs) --- | 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 +-- | If arguments is non-empty treat all arguments as filepaths and +-- parse the modules at those locations. If there are no arguments, +-- parse from stdin. +parseInput :: FromJSON a => [FilePath] -> IO [a] +parseInput = \case + [] -> ByteString.getContents >>= fmap pure . Ruby.parse + ps -> traverse Ruby.parseFile 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 +putEncoded = ByteString.putStrLn . Aeson.encode data Command = Command { targets :: [FilePath] @@ -68,20 +59,3 @@ getCommand = Options.execParser opts ( 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