SJW-0.1.2.2: benchmark/Main.hs

{-# LANGUAGE NamedFieldPuns #-}
module Main where

import SJW (Path(..), compile, source, sourceCode)
import Control.Monad (foldM)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import System.Directory (createDirectoryIfMissing, doesDirectoryExist)
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 = "/tmp/SJW-benchmark/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 = do
  directoryExists <- doesDirectoryExist destDir
  if not directoryExists
  then do
    createDirectoryIfMissing True destDir
    generateDAG 10000 10 (50, 100) >>= mapM_ writeFakeModule
  else return ()
  start <- getCurrentTime
  maybe (return ()) (\_ -> return ()) =<< sourceCode =<< compile (source [destDir])
  end <- getCurrentTime
  mapM_ putStrLn [
        "Compiled 10k modules in " ++ show (diffUTCTime end start)
      , "Left the fake project in " ++ destDir ++ " if you want to poke around"
    ]