SJW/tests/Generator.hs

84 lines
2.5 KiB
Haskell
Raw Normal View History

{-# LANGUAGE NamedFieldPuns #-}
module Main where
import SJW (Path(..))
import Control.Monad (foldM)
import System.Directory (createDirectoryIfMissing)
import System.FilePath ((</>), (<.>))
import System.Random (randomRIO)
import Text.Printf (printf)
data FakeModule = FakeModule {
name :: Path
, dependencies :: [Path]
} deriving Show
type DAG = [FakeModule]
moduleNames :: [String]
moduleNames = (:[]) <$> ['A'..'Z']
emptyModule :: Path -> FakeModule
emptyModule name = FakeModule {name, dependencies = []}
addDependency :: Path -> FakeModule -> FakeModule
addDependency path fakeModule = fakeModule {
dependencies = path : (dependencies fakeModule)
}
destDir :: FilePath
destDir = "tests/giant"
generateCode :: FakeModule -> String
generateCode (FakeModule {dependencies}) = unlines $
(printf "import %s;" . show <$> dependencies)
++ [
""
, "return {"
, " s: 'truc'"
, "};"
]
combinations :: [a] -> [[a]]
combinations l = ((:[]) <$> l) ++ concat [(:m) <$> l | m <- combinations l]
edit :: Int -> (a -> a) -> [a] -> [a]
edit 0 _ l = l
edit 1 _ [] = []
edit 1 f (x:xs) = (f x):xs
edit n f l =
let (beginning, end) = splitAt half l in
edit m f beginning ++ edit (n - m) f end
where
half = length l `div` 2
m = n `div` 2
generateDAG :: Int -> Int -> (Int, Int) -> IO DAG
generateDAG size maxTargets generationSize =
let paths = ["Main"] : (take size $ combinations moduleNames) in
addEdges [] $ emptyModule . Path <$> paths
where
addEdges ready nodes
| length nodes < 2 = return $ nodes ++ ready
| otherwise = do
(targets, chosen) <- generation nodes
addEdges (chosen ++ ready) =<< foldM edgesTo targets chosen
generation nodes = do
genSize <- randomRIO generationSize
return $ splitAt (max 1 (length nodes - genSize)) nodes
edgesTo [mainModule] (FakeModule {name}) =
return [addDependency name mainModule]
edgesTo targets (FakeModule {name}) = do
nTargets <- randomRIO (1, maxTargets)
(intact, nextGen) <- generation targets
return (intact ++ edit nTargets (addDependency name) nextGen)
writeFakeModule :: FakeModule -> IO ()
writeFakeModule fakeModule@(FakeModule {name = Path components}) =
let (parents, fileName) = splitAt (length components - 1) components in
let directory = foldl (</>) destDir parents in do
createDirectoryIfMissing True directory
writeFile (directory </> head fileName <.> "js") $ generateCode fakeModule
main :: IO ()
main = generateDAG 10000 10 (50, 100) >>= mapM_ writeFakeModule