rubyhs/src/Rubyhs.hs

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