-- | 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 '-' ]