Move parsing facilities to own module
This commit is contained in:
parent
33d7c2a26a
commit
e573e7cf14
|
@ -2,6 +2,38 @@
|
||||||
{-# OPTIONS_GHC -Wall #-}
|
{-# OPTIONS_GHC -Wall #-}
|
||||||
module Data.Language.Ruby
|
module Data.Language.Ruby
|
||||||
( module Data.Language.Ruby.AST
|
( module Data.Language.Ruby.AST
|
||||||
|
, parse
|
||||||
|
, parseFile
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Data.Aeson (eitherDecode)
|
||||||
|
import Data.ByteString.Lazy (ByteString)
|
||||||
import Data.Language.Ruby.AST
|
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
|
||||||
|
|
|
@ -2,51 +2,42 @@
|
||||||
{-# OPTIONS_GHC -Wall #-}
|
{-# OPTIONS_GHC -Wall #-}
|
||||||
module Rubyhs (main) where
|
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.Foldable (traverse_)
|
||||||
import Data.Language.Ruby (Block)
|
import Data.Language.Ruby (Block)
|
||||||
import Frelude
|
import qualified Data.Language.Ruby as Ruby
|
||||||
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 Data.Tree (Tree(Node), Forest)
|
import Data.Tree (Tree(Node), Forest)
|
||||||
|
import Frelude
|
||||||
|
import Options.Applicative (Parser)
|
||||||
import qualified Data.Aeson as Aeson
|
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 :: IO ()
|
||||||
main = do
|
main = do
|
||||||
Command{targets, printAST} <- getCommand
|
Command{targets, printAST} <- getCommand
|
||||||
blocks <- decodeInput @Block targets
|
blocks <- parseInput @Block targets
|
||||||
if printAST
|
if printAST
|
||||||
then traverse_ @[] putEncoded blocks
|
then traverse_ @[] putEncoded blocks
|
||||||
else do
|
else do
|
||||||
traverse_ (putEncoded . Rubyhs.References.references) blocks
|
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 :: Forest Rubyhs.References.Node -> Aeson.Value
|
||||||
toJSONForest = Aeson.Object . fromList . fmap go
|
toJSONForest = Aeson.Object . fromList . fmap go
|
||||||
where
|
where
|
||||||
go (Node x xs) = (Rubyhs.References.prettyContext x, toJSONForest xs)
|
go (Node x xs) = (Rubyhs.References.prettyContext x, toJSONForest xs)
|
||||||
|
|
||||||
-- | Decode from files and mappends the stuff from stdin.
|
-- | If arguments is non-empty treat all arguments as filepaths and
|
||||||
decodeInput :: FromJSON a => [FilePath] -> IO [a]
|
-- parse the modules at those locations. If there are no arguments,
|
||||||
decodeInput = \case
|
-- parse from stdin.
|
||||||
[] -> ByteString.getContents >>= fmap pure . decode
|
parseInput :: FromJSON a => [FilePath] -> IO [a]
|
||||||
ps -> traverse decodeFile ps
|
parseInput = \case
|
||||||
|
[] -> ByteString.getContents >>= fmap pure . Ruby.parse
|
||||||
|
ps -> traverse Ruby.parseFile ps
|
||||||
|
|
||||||
putEncoded :: ToJSON a => a -> IO ()
|
putEncoded :: ToJSON a => a -> IO ()
|
||||||
putEncoded = ByteString.putStrLn . encode
|
putEncoded = ByteString.putStrLn . Aeson.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
|
data Command = Command
|
||||||
{ targets :: [FilePath]
|
{ targets :: [FilePath]
|
||||||
|
@ -68,20 +59,3 @@ getCommand = Options.execParser opts
|
||||||
( Options.fullDesc
|
( Options.fullDesc
|
||||||
<> Options.progDesc "Static analysis of Ruby"
|
<> Options.progDesc "Static analysis of Ruby"
|
||||||
<> Options.header "rubyhs - 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
|
|
||||||
|
|
Loading…
Reference in a new issue