diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..6bca93e --- /dev/null +++ b/src/Main.hs @@ -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} diff --git a/src/main.hs b/src/main.hs deleted file mode 100644 index f987229..0000000 --- a/src/main.hs +++ /dev/null @@ -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