{-# 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" )