diff --git a/SJW.cabal b/SJW.cabal index ddb8130..339cb71 100644 --- a/SJW.cabal +++ b/SJW.cabal @@ -48,3 +48,28 @@ executable sjw , text default-language: Haskell2010 ghc-options: -Wall + +benchmark big-src + type: exitcode-stdio-1.0 + main-is: benchmark/Main.hs + build-depends: base >= 4.9 && <4.15 + , directory + , filepath + , random + , SJW + , time + default-language: Haskell2010 + ghc-options: -Wall + +test-suite tests + type: detailed-0.9 + test-module: Tests + build-depends: base >=4.11 && <4.13 + , Cabal + , directory + , filepath + , random + , SJW + hs-source-dirs: test + default-language: Haskell2010 + ghc-options: -Wall diff --git a/benchmark/Main.hs b/benchmark/Main.hs new file mode 100644 index 0000000..876d410 --- /dev/null +++ b/benchmark/Main.hs @@ -0,0 +1,97 @@ +{-# 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" + ] diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 index 0000000..0c0d491 --- /dev/null +++ b/test/Tests.hs @@ -0,0 +1,42 @@ +module Tests ( + tests + ) where + +import Distribution.TestSuite +import SJW (compile, source) +import System.FilePath (()) +import Text.Printf (printf) + +testData :: FilePath +testData = "test" "data" + +checkResult :: (String, Bool) -> IO Progress +checkResult (dirName, expected) = do + result <- either failed passed =<< compile (source [testData dirName]) + return . Finished $ if result == expected then Pass else Fail (explain message) + where + failed s = putStrLn s>> return False + passed _ = return True + explain = uncurry (printf "Compilation %sed when it was expected to %s") + message = if expected then ("fail", "succeed") else ("succeed", "fail") + +makeTest :: (String, Bool) -> TestInstance +makeTest (patternName, expected) = testInstance + where + testInstance = TestInstance { + run = checkResult (patternName, expected) + , name = patternName + , tags = [] + , options = [] + , setOption = \_ _ -> Right testInstance + } + +tests :: IO [Test] +tests = return $ (Test . makeTest) <$> [ + ("cycle", False) + , ("diamond", True) + , ("loop", False) + , ("q", False) + , ("simple", True) + , ("triangle", True) + ] diff --git a/test/data/cycle/A.js b/test/data/cycle/A.js new file mode 100644 index 0000000..88637a7 --- /dev/null +++ b/test/data/cycle/A.js @@ -0,0 +1,5 @@ +import B; + +return { + s: 'a' + B.s +}; diff --git a/test/data/cycle/B.js b/test/data/cycle/B.js new file mode 100644 index 0000000..0a5d695 --- /dev/null +++ b/test/data/cycle/B.js @@ -0,0 +1,5 @@ +import C; + +return { + s: 'b' + C.s +}; diff --git a/test/data/cycle/C.js b/test/data/cycle/C.js new file mode 100644 index 0000000..5de6f46 --- /dev/null +++ b/test/data/cycle/C.js @@ -0,0 +1,5 @@ +import A; + +return { + s: 'c' + A.s +} diff --git a/test/data/cycle/Main.js b/test/data/cycle/Main.js new file mode 100644 index 0000000..eb47b96 --- /dev/null +++ b/test/data/cycle/Main.js @@ -0,0 +1,3 @@ +import A; + +console.log(A.s); diff --git a/test/data/diamond/A.js b/test/data/diamond/A.js new file mode 100644 index 0000000..94c0a4b --- /dev/null +++ b/test/data/diamond/A.js @@ -0,0 +1,5 @@ +import C; + +return { + s: "Hello" + C.punctuation +}; diff --git a/test/data/diamond/B.js b/test/data/diamond/B.js new file mode 100644 index 0000000..8a631fa --- /dev/null +++ b/test/data/diamond/B.js @@ -0,0 +1,5 @@ +import C; + +return { + s: "world" + C.exclamation +}; diff --git a/test/data/diamond/C.js b/test/data/diamond/C.js new file mode 100644 index 0000000..6dcd6b3 --- /dev/null +++ b/test/data/diamond/C.js @@ -0,0 +1,4 @@ +return { + punctuation: ", ", + exclamation: " !" +}; diff --git a/test/data/diamond/Main.js b/test/data/diamond/Main.js new file mode 100644 index 0000000..736559c --- /dev/null +++ b/test/data/diamond/Main.js @@ -0,0 +1,4 @@ +import A; +import B; + +console.log(A.s + B.s); diff --git a/test/data/loop/A.js b/test/data/loop/A.js new file mode 100644 index 0000000..7744623 --- /dev/null +++ b/test/data/loop/A.js @@ -0,0 +1,5 @@ +import A; + +return { + s: 'a' + A.s +}; diff --git a/test/data/loop/Main.js b/test/data/loop/Main.js new file mode 100644 index 0000000..eb47b96 --- /dev/null +++ b/test/data/loop/Main.js @@ -0,0 +1,3 @@ +import A; + +console.log(A.s); diff --git a/test/data/q/A.js b/test/data/q/A.js new file mode 100644 index 0000000..b09c91d --- /dev/null +++ b/test/data/q/A.js @@ -0,0 +1,5 @@ +import B; + +return { + s: 'a' + B.s; +}; diff --git a/test/data/q/B.js b/test/data/q/B.js new file mode 100644 index 0000000..0a5d695 --- /dev/null +++ b/test/data/q/B.js @@ -0,0 +1,5 @@ +import C; + +return { + s: 'b' + C.s +}; diff --git a/test/data/q/C.js b/test/data/q/C.js new file mode 100644 index 0000000..27b95a4 --- /dev/null +++ b/test/data/q/C.js @@ -0,0 +1,5 @@ +import D; + +return { + s: 'c' + D.s +} diff --git a/test/data/q/D.js b/test/data/q/D.js new file mode 100644 index 0000000..2c246be --- /dev/null +++ b/test/data/q/D.js @@ -0,0 +1,5 @@ +import B; + +return { + s: 'd' + B.s +} diff --git a/test/data/q/Main.js b/test/data/q/Main.js new file mode 100644 index 0000000..eb47b96 --- /dev/null +++ b/test/data/q/Main.js @@ -0,0 +1,3 @@ +import A; + +console.log(A.s); diff --git a/test/data/simple/A.js b/test/data/simple/A.js new file mode 100644 index 0000000..7da4168 --- /dev/null +++ b/test/data/simple/A.js @@ -0,0 +1,3 @@ +return { + s: "Hello, " +}; diff --git a/test/data/simple/B.js b/test/data/simple/B.js new file mode 100644 index 0000000..4861c14 --- /dev/null +++ b/test/data/simple/B.js @@ -0,0 +1,3 @@ +return { + s: "world !" +}; diff --git a/test/data/simple/Main.js b/test/data/simple/Main.js new file mode 100644 index 0000000..736559c --- /dev/null +++ b/test/data/simple/Main.js @@ -0,0 +1,4 @@ +import A; +import B; + +console.log(A.s + B.s); diff --git a/test/data/triangle/Main.js b/test/data/triangle/Main.js new file mode 100644 index 0000000..d49b26b --- /dev/null +++ b/test/data/triangle/Main.js @@ -0,0 +1,4 @@ +import N; +import O; + +console.log(N.s + O.s); diff --git a/test/data/triangle/N.js b/test/data/triangle/N.js new file mode 100644 index 0000000..f49ed87 --- /dev/null +++ b/test/data/triangle/N.js @@ -0,0 +1,5 @@ +import O; + +return { + s: O.s +}; diff --git a/test/data/triangle/O.js b/test/data/triangle/O.js new file mode 100644 index 0000000..55ad103 --- /dev/null +++ b/test/data/triangle/O.js @@ -0,0 +1,3 @@ +return { + s: 'o' +};