···

       
12
       
 
       


     

       
13
       
 
       
module Main (main) where

     

       
14
       
 
       


     

       
15
       
-
       
import Control.Exception

     

       
16
       
 
       
import Control.Monad

     

       
0
       
 
       

     

       
17
       
 
       
import Data.Aeson as A hiding (Options, defaultOptions)

     

       
18
       
 
       
import qualified Data.Aeson.Key             as A

     

       
19
       
 
       
import qualified Data.Aeson.KeyMap          as HM

     
···

       
24
       
 
       
import qualified Data.Vector as V

     

       
25
       
 
       
import qualified Data.Yaml as Yaml

     

       
26
       
 
       
import GHC.Generics

     

       
27
       
-
       
import Options.Applicative

     

       
28
       
 
       
import System.Exit

     

       
29
       
 
       
import System.FilePath

     

       
30
       
-
       
import Test.Sandwich hiding (info)

     

       
0
       
 
       

     

       
31
       
 
       
import UnliftIO.MVar

     

       
32
       
 
       
import UnliftIO.Process

     

       
0
       
 
       

     

       
33
       
 
       


     

       
34
       
 
       


     

       
35
       
 
       
data Args = Args {

     
···

       
67
       
 
       
    Left err -> throwIO $ userError ("Couldn't decode names and counts YAML file: " <> show err)

     

       
68
       
 
       
    Right x -> pure x

     

       
69
       
 
       


     

       
70
       
-
       
  runSandwichWithCommandLineArgs' defaultOptions argsParser $ do

     

       
71
       
 
       
    miscTests args

     

       
72
       
 
       


     

       
73
       
 
       
    describe ("Building environments for top " <> show topN <> " Julia packages") $

     

       
74
       
-
       
      parallelN parallelism $

     

       
75
       
-
       
        forM_ (L.take topN namesAndCounts) $ \(NameAndCount {..}) ->

     

       
76
       
-
       
          testExpr args name [i|#{juliaAttr}.withPackages ["#{name}"]|]

     

       
0
       
 
       

     

       
0
       
 
       

     

       
77
       
 
       


     

       
78
       
 
       
miscTests :: Args -> SpecFree ctx IO ()

     

       
79
       
 
       
miscTests args@(Args {..}) = describe "Misc tests" $ do

     
···

       
89
       
 
       
                                      };

     

       
90
       
 
       
                                    }) [ "HelloWorld" ]|]

     

       
91
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
92
       
 
       
-- * Low-level

     

       
93
       
 
       


     

       
94
       
 
       
testExpr :: Args -> Text -> String -> SpecFree ctx IO ()

     
···

       
98
       
 
       
      let cp = proc "nix" ["build", "--impure", "--no-link", "--json", "--expr", [i|with import ../../../../. {}; #{expr}|]]

     

       
99
       
 
       
      output <- readCreateProcessWithLogging cp ""

     

       
100
       
 
       
      juliaPath <- case A.eitherDecode (BL8.pack output) of

     

       
101
       
-
       
        Right (A.Array ((V.!? 0) -> Just (A.Object (aesonLookup "outputs" -> Just (A.Object (aesonLookup "out" -> Just (A.String t))))))) -> pure (JuliaPath ((T.unpack t) </> "bin" </> "julia"))

     

       
0
       
 
       

     

       
0
       
 
       

     

       
102
       
 
       
        x -> expectationFailure ("Couldn't parse output: " <> show x)

     

       
103
       
 
       


     

       
104
       
 
       
      getContext julia >>= flip modifyMVar_ (const $ return (Just juliaPath))

     
···

       
113
       
 
       
  where

     

       
114
       
 
       
    aesonLookup :: Text -> HM.KeyMap v -> Maybe v

     

       
115
       
 
       
    aesonLookup = HM.lookup . A.fromText

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

···

       
12
       
 
       


     

       
13
       
 
       
module Main (main) where

     

       
14
       
 
       


     

       
0
       
 
       

     

       
15
       
 
       
import Control.Monad

     

       
16
       
+
       
import Control.Monad.IO.Class

     

       
17
       
 
       
import Data.Aeson as A hiding (Options, defaultOptions)

     

       
18
       
 
       
import qualified Data.Aeson.Key             as A

     

       
19
       
 
       
import qualified Data.Aeson.KeyMap          as HM

     
···

       
24
       
 
       
import qualified Data.Vector as V

     

       
25
       
 
       
import qualified Data.Yaml as Yaml

     

       
26
       
 
       
import GHC.Generics

     

       
27
       
+
       
import Options.Applicative hiding (info)

     

       
28
       
 
       
import System.Exit

     

       
29
       
 
       
import System.FilePath

     

       
30
       
+
       
import Test.Sandwich

     

       
31
       
+
       
import UnliftIO.Exception

     

       
32
       
 
       
import UnliftIO.MVar

     

       
33
       
 
       
import UnliftIO.Process

     

       
34
       
+
       
import UnliftIO.QSem

     

       
35
       
 
       


     

       
36
       
 
       


     

       
37
       
 
       
data Args = Args {

     
···

       
69
       
 
       
    Left err -> throwIO $ userError ("Couldn't decode names and counts YAML file: " <> show err)

     

       
70
       
 
       
    Right x -> pure x

     

       
71
       
 
       


     

       
72
       
+
       
  runSandwichWithCommandLineArgs' defaultOptions argsParser $ parallel $ do

     

       
73
       
 
       
    miscTests args

     

       
74
       
 
       


     

       
75
       
 
       
    describe ("Building environments for top " <> show topN <> " Julia packages") $

     

       
76
       
+
       
      introduce "Introduce parallel semaphore" parallelSemaphore (liftIO $ newQSem parallelism) (const $ return ()) $

     

       
77
       
+
       
      parallel $

     

       
78
       
+
       
      forM_ (L.take topN namesAndCounts) $ \(NameAndCount {..}) ->

     

       
79
       
+
       
      around "Claim semaphore" claimRunSlot $

     

       
80
       
+
       
      testExpr args name [i|#{juliaAttr}.withPackages ["#{name}"]|]

     

       
81
       
 
       


     

       
82
       
 
       
miscTests :: Args -> SpecFree ctx IO ()

     

       
83
       
 
       
miscTests args@(Args {..}) = describe "Misc tests" $ do

     
···

       
93
       
 
       
                                      };

     

       
94
       
 
       
                                    }) [ "HelloWorld" ]|]

     

       
95
       
 
       


     

       
96
       
+
       
  describe "misc cases" $ do

     

       
97
       
+
       
    testExpr args "Optimization" [iii|(#{juliaAttr}.withPackages) [ "Optimization" "OptimizationOptimJL" ]|]

     

       
98
       
+
       


     

       
99
       
 
       
-- * Low-level

     

       
100
       
 
       


     

       
101
       
 
       
testExpr :: Args -> Text -> String -> SpecFree ctx IO ()

     
···

       
105
       
 
       
      let cp = proc "nix" ["build", "--impure", "--no-link", "--json", "--expr", [i|with import ../../../../. {}; #{expr}|]]

     

       
106
       
 
       
      output <- readCreateProcessWithLogging cp ""

     

       
107
       
 
       
      juliaPath <- case A.eitherDecode (BL8.pack output) of

     

       
108
       
+
       
        Right (A.Array ((V.!? 0) -> Just (A.Object (aesonLookup "outputs" -> Just (A.Object (aesonLookup "out" -> Just (A.String t))))))) -> do

     

       
109
       
+
       
          info [i|built: #{t}|]

     

       
110
       
+
       
          pure (JuliaPath ((T.unpack t) </> "bin" </> "julia"))

     

       
111
       
 
       
        x -> expectationFailure ("Couldn't parse output: " <> show x)

     

       
112
       
 
       


     

       
113
       
 
       
      getContext julia >>= flip modifyMVar_ (const $ return (Just juliaPath))

     
···

       
122
       
 
       
  where

     

       
123
       
 
       
    aesonLookup :: Text -> HM.KeyMap v -> Maybe v

     

       
124
       
 
       
    aesonLookup = HM.lookup . A.fromText

     

       
125
       
+
       


     

       
126
       
+
       
claimRunSlot :: (HasParallelSemaphore ctx) => ExampleT ctx IO a -> ExampleT ctx IO ()

     

       
127
       
+
       
claimRunSlot f = do

     

       
128
       
+
       
  s <- getContext parallelSemaphore

     

       
129
       
+
       
  bracket_ (liftIO $ waitQSem s) (liftIO $ signalQSem s) (void f)