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

View File

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