General rewrite with Data.Text
This commit is contained in:
parent
245566e059
commit
88864d4998
67
src/Main.hs
Normal file
67
src/Main.hs
Normal file
@ -0,0 +1,67 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
import Control.Monad (when, forever)
|
||||
import Data.Text (unpack)
|
||||
import System.Console.ArgParser
|
||||
import Alea.Diceware
|
||||
import Paths_alea (getDataFileName)
|
||||
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Text.IO as I
|
||||
|
||||
|
||||
-- * Command line interface description
|
||||
|
||||
-- | Program arguments record
|
||||
data ProgArgs = ProgArgs
|
||||
{ interactive :: Bool
|
||||
, dictionary :: FilePath
|
||||
, phraseLength :: Int
|
||||
, phrases :: Int
|
||||
} deriving (Show)
|
||||
|
||||
|
||||
-- | Default dictionary path
|
||||
defaultPath :: IO FilePath
|
||||
defaultPath = getDataFileName "dict/diceware"
|
||||
|
||||
|
||||
-- | Arguments descriptions
|
||||
argParser :: FilePath -> ParserSpec ProgArgs
|
||||
argParser path = ProgArgs
|
||||
`parsedBy` boolFlag "interactive" `Descr` "Manually insert numbers"
|
||||
`andBy` optFlag path "dictionary" `Descr` "Specify dictionary filepath"
|
||||
`andBy` optFlag 6 "lenght" `Descr` "Number of words in a passphrase"
|
||||
`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
|
||||
|
||||
-- | Main function
|
||||
main :: IO ()
|
||||
main = defaultPath >>= interface >>= (`runApp` diceware)
|
||||
|
||||
|
||||
-- | Actual application
|
||||
diceware :: ProgArgs -> IO ()
|
||||
diceware args@ProgArgs{..} = do
|
||||
dict <- fmap parseDiceware (I.readFile dictionary)
|
||||
let size = length dict-1
|
||||
dice = readDiceware dict . read . unpack
|
||||
dice' = readDiceware' dict
|
||||
|
||||
if interactive
|
||||
then forever (fmap dice I.getLine >>= I.putStrLn)
|
||||
else do
|
||||
indices <- genIndex size phraseLength
|
||||
I.putStrLn $ T.unwords (map dice' indices)
|
||||
when (phrases > 1) $
|
||||
diceware args {phrases = phrases - 1}
|
55
src/main.hs
55
src/main.hs
@ -1,55 +0,0 @@
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
|
||||
import System.IO
|
||||
import System.Console.ArgParser
|
||||
import Control.Monad
|
||||
|
||||
import Paths_alea (getDataFileName)
|
||||
import Alea.Diceware
|
||||
import Alea.Random
|
||||
|
||||
data ProgArgs = ProgArgs
|
||||
{ interactive :: Bool
|
||||
, dictionary :: FilePath
|
||||
, phraseLength :: Int
|
||||
, phrases :: Int
|
||||
} deriving (Show)
|
||||
|
||||
parser :: IO (ParserSpec ProgArgs)
|
||||
parser = (\path -> ProgArgs
|
||||
`parsedBy` boolFlag "interactive" `Descr` "Manually insert numbers"
|
||||
`andBy` optFlag path "dictionary" `Descr` "Specify dictionary file path"
|
||||
`andBy` optFlag 6 "lenght" `Descr` "Number of words in a passphrase"
|
||||
`andBy` optFlag 1 "phrases" `Descr` "Number of passphrases to generate")
|
||||
<$> path
|
||||
|
||||
interface :: IO (CmdLnInterface ProgArgs)
|
||||
interface =
|
||||
(`setAppDescr` "A diceware passphrase generator") <$>
|
||||
(`setAppEpilog` "Alea iacta est.") <$>
|
||||
(mkApp =<< parser)
|
||||
|
||||
main :: IO ()
|
||||
main = interface >>= flip runApp (readDict >=> exec)
|
||||
|
||||
-- Default path of the dictionary
|
||||
path :: IO FilePath
|
||||
path = getDataFileName "dict/diceware"
|
||||
|
||||
-- Read dictionary file
|
||||
readDict :: ProgArgs -> IO ProgArgs
|
||||
readDict args@ProgArgs{..} =
|
||||
(\x -> args {dictionary = x}) <$> readFile dictionary
|
||||
|
||||
-- Main function
|
||||
exec :: ProgArgs -> IO ()
|
||||
exec args@ProgArgs{..} =
|
||||
if interactive
|
||||
then interact (unlines . map dice . lines)
|
||||
else do
|
||||
randWords dictSize phraseLength >>= putStrLn . unwords . map dice'
|
||||
when (phrases > 1) $ exec args {phrases = phrases - 1}
|
||||
where
|
||||
(dict, dictSize) = (parseDiceware dictionary, length dict)
|
||||
dice n = readDiceware dict (read n :: Int)
|
||||
dice' n = readDiceware' dict n
|
Loading…
Reference in New Issue
Block a user