89 lines
2.8 KiB
Haskell
89 lines
2.8 KiB
Haskell
{-# LANGUAGE DuplicateRecordFields, OverloadedLists #-}
|
|
{-# OPTIONS_GHC -Wall #-}
|
|
module Rubyhs (main) where
|
|
|
|
import Data.Foldable (traverse_)
|
|
import Data.Language.Ruby (Block)
|
|
import Data.Map (Map)
|
|
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
|
|
|
|
main :: IO ()
|
|
main = do
|
|
Command{targets, printAST, maybeDotPath} <- getCommand
|
|
blocks <- parseInput @Block targets
|
|
let
|
|
act block = do
|
|
let res@(Rubyhs.References.Result x) = Rubyhs.References.references $ block
|
|
putEncoded res
|
|
ByteString.putStrLn . Aeson.encode . toJSONForest . Rubyhs.References.graph $ block
|
|
case maybeDotPath of
|
|
Nothing -> pure ()
|
|
Just dotPath -> drawDot dotPath x
|
|
if printAST
|
|
then traverse_ @[] putEncoded blocks
|
|
else traverse_ act blocks
|
|
|
|
drawDot :: FilePath -> Map Rubyhs.References.Node (Set Rubyhs.References.Node) -> IO ()
|
|
drawDot p
|
|
= Text.writeFile p
|
|
. Graphviz.digraph
|
|
. fmap (fmap (qoutes . Rubyhs.References.prettyContext) . \(x, xs) -> x :| toList xs)
|
|
. toList
|
|
|
|
qoutes :: Text -> Text
|
|
qoutes x = "\"" <> x <> "\""
|
|
|
|
toJSONForest :: Forest Rubyhs.References.Node -> Aeson.Value
|
|
toJSONForest = Aeson.Object . fromList . fmap go
|
|
where
|
|
go (Node x xs) = (Rubyhs.References.prettyContext x, toJSONForest xs)
|
|
|
|
-- | 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
|
|
, maybeDotPath :: Maybe FilePath
|
|
}
|
|
|
|
command :: Parser Command
|
|
command = Command <$> targets <*> printAST <*> dotPath
|
|
where
|
|
targets = many (Options.argument Options.str (Options.metavar "TARGET"))
|
|
printAST = Options.switch
|
|
$ Options.long "print-ast"
|
|
<> Options.help "Print AST and exit"
|
|
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" )
|