diff --git a/package.yaml b/package.yaml index cf34c55..8f151fa 100644 --- a/package.yaml +++ b/package.yaml @@ -31,6 +31,8 @@ dependencies: - mtl - prettyprinter - unordered-containers + - optparse-applicative + - temporary default-extensions: - ConstraintKinds diff --git a/src/Rubyhs.hs b/src/Rubyhs.hs index 8cd4deb..6617034 100644 --- a/src/Rubyhs.hs +++ b/src/Rubyhs.hs @@ -8,29 +8,72 @@ import Data.ByteString.Lazy (ByteString) import Data.Foldable (traverse_) import Data.Language.Ruby (Block) import Frelude -import System.Environment (getArgs) import System.Process (readProcess) import qualified Data.ByteString.Lazy.Char8 as ByteString import Rubyhs.References (references) +import Options.Applicative (Parser) +import qualified Options.Applicative as Options +import System.IO.Temp (withSystemTempFile) +import System.IO (hFlush) main :: IO () -main = getArgs >>= traverse_ run +main = do + Command{targets, printAST} <- getCommand + blocks <- decodeInput @Block targets + if printAST + then traverse_ @[] putEncoded blocks + else traverse_ (putEncoded . references) blocks -run :: FilePath -> IO () -run p = do - json <- runParser p - block <- decodeFail @_ @Block $ ByteString.pack json - ByteString.putStrLn $ encode block - ByteString.putStrLn $ encode $ references block +-- | Decode from files and mappends the stuff from stdin. +decodeInput :: FromJSON a => [FilePath] -> IO [a] +decodeInput = \case + [] -> ByteString.getContents >>= fmap pure . decode + ps -> traverse decodeFile ps + +putEncoded :: ToJSON a => a -> IO () +putEncoded = ByteString.putStrLn . 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 + { targets :: [FilePath] + , printAST :: Bool + } + +command :: Parser Command +command = Command <$> targets <*> printAST + where + targets = many (Options.argument Options.str (Options.metavar "TARGET")) + printAST = Options.switch + $ Options.long "quiet" + <> Options.short 'q' + <> Options.help "Whether to be quiet" + +getCommand :: IO Command +getCommand = Options.execParser opts + where + opts = Options.info (Options.helper <*> command) + ( Options.fullDesc + <> Options.progDesc "Print a greeting for TARGET" + <> Options.header "hello - a test for optparse-applicative" ) decodeFail :: MonadFail m => FromJSON a => ByteString -> m a decodeFail s = case eitherDecode s of Left err -> Frelude.fail err Right a -> pure a -runParser :: FilePath -> IO String -runParser p = sh "ruby-parse" ["--emit-json", "--25", p] +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 -