Optparse Applicative

This commit is contained in:
Frederik Hanghøj Iversen 2019-10-14 21:46:02 +02:00
parent 60445d6bb8
commit 187c1fc0ce
2 changed files with 56 additions and 11 deletions

View file

@ -31,6 +31,8 @@ dependencies:
- mtl - mtl
- prettyprinter - prettyprinter
- unordered-containers - unordered-containers
- optparse-applicative
- temporary
default-extensions: default-extensions:
- ConstraintKinds - ConstraintKinds

View file

@ -8,29 +8,72 @@ import Data.ByteString.Lazy (ByteString)
import Data.Foldable (traverse_) import Data.Foldable (traverse_)
import Data.Language.Ruby (Block) import Data.Language.Ruby (Block)
import Frelude import Frelude
import System.Environment (getArgs)
import System.Process (readProcess) import System.Process (readProcess)
import qualified Data.ByteString.Lazy.Char8 as ByteString import qualified Data.ByteString.Lazy.Char8 as ByteString
import Rubyhs.References (references) 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 :: 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 () -- | Decode from files and mappends the stuff from stdin.
run p = do decodeInput :: FromJSON a => [FilePath] -> IO [a]
json <- runParser p decodeInput = \case
block <- decodeFail @_ @Block $ ByteString.pack json [] -> ByteString.getContents >>= fmap pure . decode
ByteString.putStrLn $ encode block ps -> traverse decodeFile ps
ByteString.putStrLn $ encode $ references block
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 :: MonadFail m => FromJSON a => ByteString -> m a
decodeFail s = case eitherDecode s of decodeFail s = case eitherDecode s of
Left err -> Frelude.fail err Left err -> Frelude.fail err
Right a -> pure a Right a -> pure a
runParser :: FilePath -> IO String runRubyParseFile :: FilePath -> IO String
runParser p = sh "ruby-parse" ["--emit-json", "--25", p] 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 :: String -> [String] -> IO String
sh cmd args = readProcess cmd args mempty sh cmd args = readProcess cmd args mempty