Move parsing facilities to own module

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-16 20:33:15 +02:00
parent 33d7c2a26a
commit e573e7cf14
2 changed files with 48 additions and 42 deletions

View File

@ -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

View File

@ -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