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