Optparse Applicative
This commit is contained in:
parent
60445d6bb8
commit
187c1fc0ce
|
@ -31,6 +31,8 @@ dependencies:
|
||||||
- mtl
|
- mtl
|
||||||
- prettyprinter
|
- prettyprinter
|
||||||
- unordered-containers
|
- unordered-containers
|
||||||
|
- optparse-applicative
|
||||||
|
- temporary
|
||||||
|
|
||||||
default-extensions:
|
default-extensions:
|
||||||
- ConstraintKinds
|
- ConstraintKinds
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue