cartel-0.12.0.0: tests/cartel-visual-test.hs

-- | Generates random Cabal text.  The program takes two arguments.
-- The first is a size parameter.  This should be a non-negative
-- integer.  Bigger sizes will result in bigger results generated.
-- The second argument is the random seed.  It should be any integer.
-- Different seeds should generate different results.
module Main where

import Data.Word
import Cartel.Generators
import System.Environment
import Data.Either
import Text.Read (readMaybe)
import System.Random
import System.Exit
import qualified System.IO as IO
import Multiarg

maxSize :: Word
maxSize = 10

help :: (String -> String)
help pn = unlines
  [ pn ++ " - generates random Cabal text."
  , "Options:"
  , "  --size INT - runs generator with the given size."
  , "               INT must be non-negative.  Larger INT will"
  , "               result in larger results."
  , "  --seed INT - runs generator with the given seed."
  , "  Without these options, a random seed is chosen, and"
  , "  a random size between 0 and " ++ show maxSize ++ " is chosen."
  ]

opts :: [OptSpec (IO (Either Word Int))]
opts =
  [ optSpec "" ["size"] (OneArg (fmap Left . readVal))
  , optSpec "" ["seed"] (OneArg (fmap Right . readVal))
  ]

failOnPosArg :: IO a
failOnPosArg = do
  pn <- getProgName
  fail $ pn ++ " does not accept positional arguments."

finalOptions :: [Either Word Int] -> IO (Word, Int)
finalOptions ls = do
  let (ws, is) = partitionEithers ls
  sz <- case safeLast ws of
    Nothing -> randomRIO (0, maxSize)
    Just x -> return x
  sd <- case safeLast is of
    Nothing -> randomIO
    Just x -> return x
  return (sz, sd)

safeLast :: [a] -> Maybe a
safeLast xs
  | null xs = Nothing
  | otherwise = Just . last $ xs

readVal :: Read a => String -> IO a
readVal s = maybe (fail $ "could not read string: " ++ s) return
  . readMaybe $ s

main :: IO ()
main = do
  eithersActs <- parseCommandLine help opts (const failOnPosArg)
  eithers <- sequence eithersActs
  (sz, sd) <- finalOptions eithers
  case genCabalText sz sd of
    Left e -> do
      IO.hPutStrLn IO.stderr "could not generate Cabal text."
      IO.hPutStr IO.stderr e
      exitFailure
    Right g -> printHeader sz sd >> putStr g >> exitSuccess

printHeader :: Word -> Int -> IO ()
printHeader sz sd = putStr $ unlines
  [ replicate 50 '-'
  , "-- below - size: " ++ show sz ++ " seed: " ++ show sd
  , replicate 50 '-'
  ]