Drop argparser
This commit is contained in:
parent
7aba6236f9
commit
b3bb13eb62
@ -29,5 +29,6 @@ executable alea
|
|||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
other-modules: Alea.Diceware
|
other-modules: Alea.Diceware
|
||||||
other-extensions: DeriveDataTypeable, RecordWildCards
|
other-extensions: DeriveDataTypeable, RecordWildCards
|
||||||
build-depends: base >=4.8 && < 5.0, random, text, argparser
|
build-depends: base >=4.8 && < 5.0, random, text,
|
||||||
|
optparse-applicative
|
||||||
ghc-options: -O2
|
ghc-options: -O2
|
||||||
|
66
src/Main.hs
66
src/Main.hs
@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
import Control.Monad (when, forever)
|
import Control.Monad (when, forever)
|
||||||
import Data.Text (unpack)
|
import Data.Text (unpack)
|
||||||
import System.Console.ArgParser
|
import Options.Applicative
|
||||||
import Alea.Diceware
|
import Alea.Diceware
|
||||||
import Paths_alea (getDataFileName)
|
import Paths_alea (getDataFileName)
|
||||||
|
|
||||||
@ -13,55 +13,67 @@ import qualified Data.Text.IO as I
|
|||||||
-- * Command line interface description
|
-- * Command line interface description
|
||||||
|
|
||||||
-- | Program arguments record
|
-- | Program arguments record
|
||||||
data ProgArgs = ProgArgs
|
data Options = Options
|
||||||
{ interactive :: Bool
|
{ interactive :: Bool
|
||||||
, dictionary :: FilePath
|
, dictionary :: Maybe FilePath
|
||||||
, phraseLength :: Int
|
, phraseLength :: Int
|
||||||
, phrases :: Int
|
, phrases :: Int
|
||||||
} deriving (Show)
|
}
|
||||||
|
|
||||||
|
|
||||||
-- | Default dictionary path
|
-- | Argument parser
|
||||||
defaultPath :: IO FilePath
|
options :: Parser Options
|
||||||
defaultPath = getDataFileName "dict/diceware"
|
options = Options
|
||||||
|
<$> switch
|
||||||
|
( long "interactive"
|
||||||
|
<> help "Manually insert numbers from a dice" )
|
||||||
|
<*> optional (option auto
|
||||||
|
( long "dictionary"
|
||||||
|
<> metavar "FILEPATH"
|
||||||
|
<> help "Specify dictionary filepath" ))
|
||||||
|
<*> option auto
|
||||||
|
( long "length"
|
||||||
|
<> value 6
|
||||||
|
<> metavar "N"
|
||||||
|
<> help "Number of words in a passphrase")
|
||||||
|
<*> option auto
|
||||||
|
( long "phrases"
|
||||||
|
<> value 1
|
||||||
|
<> metavar "M"
|
||||||
|
<> help "Number of passphrases to generate" )
|
||||||
|
|
||||||
|
|
||||||
-- | Arguments descriptions
|
-- | Program description
|
||||||
argParser :: FilePath -> ParserSpec ProgArgs
|
description :: ParserInfo Options
|
||||||
argParser path = ProgArgs
|
description = info (helper <*> options)
|
||||||
`parsedBy` boolFlag "interactive" `Descr` "Manually insert numbers"
|
( fullDesc
|
||||||
`andBy` optFlag path "dictionary" `Descr` "Specify dictionary filepath"
|
<> progDesc "A diceware passphrase generator"
|
||||||
`andBy` optFlag 6 "lenght" `Descr` "Number of words in a passphrase"
|
<> footer "Alea iacta est." )
|
||||||
`andBy` optFlag 1 "phrases" `Descr` "Number of passphrases to generate"
|
|
||||||
|
|
||||||
|
|
||||||
-- | CLI interface
|
|
||||||
interface :: FilePath -> IO (CmdLnInterface ProgArgs)
|
|
||||||
interface path =
|
|
||||||
(`setAppDescr` "A diceware passphrase generator") <$>
|
|
||||||
(`setAppEpilog` "Alea iacta est.") <$>
|
|
||||||
mkApp (argParser path)
|
|
||||||
|
|
||||||
|
|
||||||
-- * Program
|
-- * Program
|
||||||
|
|
||||||
-- | Main function
|
-- | Main function
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = defaultPath >>= interface >>= (`runApp` diceware)
|
main = execParser description >>= diceware
|
||||||
|
|
||||||
|
|
||||||
-- | Actual application
|
-- | Actual application
|
||||||
diceware :: ProgArgs -> IO ()
|
diceware :: Options -> IO ()
|
||||||
diceware args@ProgArgs{..} = do
|
diceware opts@Options{..} = do
|
||||||
dict <- fmap parseDiceware (I.readFile dictionary)
|
path <- case dictionary of
|
||||||
|
Nothing -> getDataFileName "dict/diceware"
|
||||||
|
Just x -> return x
|
||||||
|
dict <- parseDiceware <$> I.readFile path
|
||||||
let size = length dict-1
|
let size = length dict-1
|
||||||
dice = readDiceware dict . read . unpack
|
dice = readDiceware dict . read . unpack
|
||||||
dice' = readDiceware' dict
|
dice' = readDiceware' dict
|
||||||
|
|
||||||
if interactive
|
if interactive
|
||||||
then forever (fmap dice I.getLine >>= I.putStrLn)
|
then forever (dice <$> I.getLine >>= I.putStrLn)
|
||||||
else do
|
else do
|
||||||
indices <- randIndices size phraseLength
|
indices <- randIndices size phraseLength
|
||||||
I.putStrLn $ T.unwords (map dice' indices)
|
I.putStrLn $ T.unwords (map dice' indices)
|
||||||
when (phrases > 1) $
|
when (phrases > 1) $
|
||||||
diceware args {phrases = phrases - 1}
|
diceware opts {phrases = phrases - 1}
|
||||||
|
Loading…
Reference in New Issue
Block a user