1{-# LANGUAGE LambdaCase #-} 2{-# LANGUAGE PatternGuards #-} 3 4module Test.Random(main) where 5 6import Development.Shake 7import Numeric.Extra 8import Test.Type 9import Control.Exception.Extra 10import Control.Monad 11import Data.List 12import Data.Maybe 13import General.GetOpt 14import System.Environment 15import System.Exit 16import System.Random 17import General.Extra 18import qualified System.IO.Extra as IO 19import System.Time.Extra 20 21 22inputRange = [1..10] 23 24data Value = Single Int | Multiple [[Value]] 25 deriving (Read,Show,Eq) 26 27data Source = Input Int | Output Int | Bang 28 deriving (Read,Show) 29 30data Logic = Logic Int [[Source]] 31 | Want [Int] 32 deriving (Read,Show) 33 34arg = [Option "" ["arg"] (ReqArg Right "") ""] 35 36main = testBuildArgs test arg $ \args -> do 37 let toFile (Input i) = "input-" ++ show i ++ ".txt" 38 toFile (Output i) = "output-" ++ show i ++ ".txt" 39 toFile Bang = error "BANG" 40 41 let randomSleep = liftIO $ do 42 i <- randomRIO (0, 25) 43 sleep $ intToDouble i / 100 44 45 forM_ (map read $ filter (isNothing . asDuration) args) $ \case 46 Want xs -> want $ map (toFile . Output) xs 47 Logic out srcs -> toFile (Output out) %> \out -> do 48 res <- fmap (show . Multiple) $ forM srcs $ \src -> do 49 randomSleep 50 need $ map toFile src 51 mapM (liftIO . fmap read . IO.readFile' . toFile) src 52 randomSleep 53 writeFileChanged out res 54 55 56asDuration :: String -> Maybe Double 57asDuration x 58 | "s" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just i 59 | "m" `isSuffixOf` x, [(i,"")] <- reads $ init x = Just $ i * 60 60 | otherwise = Nothing 61 62 63test build = do 64 limit <- do 65 args <- getArgs 66 let bound = listToMaybe $ reverse $ mapMaybe asDuration args 67 time <- offsetTime 68 pure $ when (isJust bound) $ do 69 now <- time 70 when (now > fromJust bound) exitSuccess 71 72 forM_ [1..] $ \count -> do 73 limit 74 putStrLn $ "* PERFORMING RANDOM TEST " ++ show count 75 build ["clean"] 76 build [] -- to create the directory 77 forM_ inputRange $ \i -> 78 writeFile ("input-" ++ show i ++ ".txt") $ show $ Single i 79 logic <- randomLogic 80 runLogic [] logic 81 chng <- filterM (const randomIO) inputRange 82 forM_ chng $ \i -> 83 writeFile ("input-" ++ show i ++ ".txt") $ show $ Single $ negate i 84 runLogic chng logic 85 forM_ inputRange $ \i -> 86 writeFile ("input-" ++ show i ++ ".txt") $ show $ Single i 87 logicBang <- addBang =<< addBang logic 88 j <- randomRIO (1::Int,8) 89 res <- try_ $ build $ "--exception" : ("-j" ++ show j) : map ((++) "--arg=" . show) (logicBang ++ [Want [i | Logic i _ <- logicBang]]) 90 case res of 91 Left err 92 | "BANG" `isInfixOf` show err -> pure () -- error I expected 93 | otherwise -> error $ "UNEXPECTED ERROR: " ++ show err 94 _ -> pure () -- occasionally we only put BANG in places with no dependenies that don't get rebuilt 95 runLogic [] $ logic ++ [Want [i | Logic i _ <- logic]] 96 where 97 runLogic :: [Int] -> [Logic] -> IO () 98 runLogic negated xs = do 99 let poss = [i | Logic i _ <- xs] 100 i <- randomRIO (0, 7) 101 wants <- replicateM i $ do 102 i <- randomRIO (0, 5) 103 replicateM i $ randomElem poss 104 sleepFileTime 105 j <- randomRIO (1::Int,8) 106 build $ ("-j" ++ show j) : map ((++) "--arg=" . show) (xs ++ map Want wants) 107 108 let value i = 109 let ys = head [ys | Logic j ys <- xs, j == i] 110 in Multiple $ flip map ys $ map $ \case 111 Input i -> Single $ if i `elem` negated then negate i else i 112 Output i -> value i 113 Bang -> error "BANG" 114 forM_ (concat wants) $ \i -> do 115 let wanted = value i 116 got <- fmap read $ IO.readFile' $ "output-" ++ show i ++ ".txt" 117 when (wanted /= got) $ 118 error $ "INCORRECT VALUE for " ++ show i 119 120 121addBang :: [Logic] -> IO [Logic] 122addBang xs = do 123 i <- randomRIO (0, length xs - 1) 124 let (before,now:after) = splitAt i xs 125 now <- f now 126 pure $ before ++ now : after 127 where 128 f (Logic log xs) = do 129 i <- randomRIO (0, length xs) 130 let (before,after) = splitAt i xs 131 pure $ Logic log $ before ++ [Bang] : after 132 f x = pure x 133 134 135randomLogic :: IO [Logic] -- only Logic constructors 136randomLogic = do 137 rules <- randomRIO (1,100) 138 f rules $ map Input inputRange 139 where 140 f 0 _ = pure [] 141 f i avail = do 142 needs <- randomRIO (0,3) 143 xs <- replicateM needs $ do 144 ns <- randomRIO (0,3) 145 replicateM ns $ randomElem avail 146 let r = Logic i xs 147 (r:) <$> f (i-1) (Output i:avail) 148