102 lines
3.0 KiB
Haskell
102 lines
3.0 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields, OverloadedLists #-}
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
module Rubyhs (main) where
|
|
|
|
import Data.Foldable (traverse_)
|
|
import Data.HashMap.Strict (HashMap)
|
|
import Data.Set (Set)
|
|
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 Data.Graphviz as Graphviz
|
|
import qualified Data.Language.Ruby as Ruby
|
|
import qualified Data.Text.IO as Text
|
|
import qualified Options.Applicative as Options
|
|
import qualified Rubyhs.References as Ruby
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Command{targets, printAST, printRefs, printGraph, maybeDotPath} <- getCommand
|
|
begins <- parseInput @Ruby.Begin targets
|
|
let
|
|
act begin = do
|
|
let res@(Ruby.Result x) = Ruby.references $ begin
|
|
when printAST $ putEncoded begin
|
|
when printRefs $ putEncoded res
|
|
when printGraph $ drawGraph $ Ruby.graph begin
|
|
case maybeDotPath of
|
|
Nothing -> pure ()
|
|
Just dotPath -> drawDot dotPath x
|
|
traverse_ act begins
|
|
|
|
drawDot :: FilePath -> HashMap Ruby.Node (Set Ruby.Node) -> IO ()
|
|
drawDot p
|
|
= Text.writeFile p
|
|
. Graphviz.digraph
|
|
. fmap (fmap (qoutes . Ruby.prettyContext) . \(x, xs) -> x :| toList xs)
|
|
. toList
|
|
|
|
drawGraph :: Forest Ruby.Node -> IO ()
|
|
drawGraph
|
|
= ByteString.putStrLn
|
|
. Aeson.encode
|
|
. toJSONForest
|
|
. fmap (fmap Ruby.prettyContext)
|
|
|
|
qoutes :: Text -> Text
|
|
qoutes x = "\"" <> x <> "\""
|
|
|
|
toJSONForest :: Forest Text -> Aeson.Value
|
|
toJSONForest = Aeson.Object . fromList . fmap go
|
|
where
|
|
go (Node a as) = (a, toJSONForest as)
|
|
|
|
-- | 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 . Aeson.encode
|
|
|
|
data Command = Command
|
|
{ targets :: [FilePath]
|
|
, printAST :: Bool
|
|
, printRefs :: Bool
|
|
, printGraph :: Bool
|
|
, maybeDotPath :: Maybe FilePath
|
|
}
|
|
|
|
command :: Parser Command
|
|
command = Command <$> targets <*> printAST <*> printRefs <*> printGraph <*> dotPath
|
|
where
|
|
targets = many (Options.argument Options.str (Options.metavar "TARGET"))
|
|
printAST = Options.switch
|
|
$ Options.long "ast"
|
|
<> Options.help "Print AST"
|
|
printRefs = Options.switch
|
|
$ Options.long "refs"
|
|
<> Options.help "Print references"
|
|
printGraph = Options.switch
|
|
$ Options.long "graph"
|
|
<> Options.help "Print call graph"
|
|
dotPath
|
|
= Options.optional
|
|
$ Options.strOption
|
|
$ Options.long "dot"
|
|
<> Options.metavar "PATH"
|
|
<> Options.help "Write dot graph"
|
|
|
|
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" )
|