tjh.dev
nixpkgs mirror (for testing)
github.com/NixOS/nixpkgs
nix
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveAnyClass #-}
3{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE LambdaCase #-}
6{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE QuasiQuotes #-}
8{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE RecordWildCards #-}
10{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ViewPatterns #-}
12
13module Main (main) where
14
15import Control.Monad
16import Control.Monad.IO.Class
17import Data.Aeson as A hiding (Options, defaultOptions)
18import qualified Data.Aeson.Key as A
19import qualified Data.Aeson.KeyMap as HM
20import qualified Data.ByteString.Lazy.Char8 as BL8
21import qualified Data.List as L
22import Data.String.Interpolate
23import Data.Text as T hiding (count)
24import qualified Data.Vector as V
25import qualified Data.Yaml as Yaml
26import GHC.Generics
27import Options.Applicative hiding (info)
28import System.Exit
29import System.FilePath
30import Test.Sandwich
31import UnliftIO.Exception
32import UnliftIO.MVar
33import UnliftIO.Process
34import UnliftIO.QSem
35
36
37data Args = Args {
38 countFilePath :: FilePath
39 , topN :: Int
40 , parallelism :: Int
41 , juliaAttr :: Text
42 }
43
44argsParser :: Parser Args
45argsParser = Args
46 <$> strOption (long "count-file" <> short 'c' <> help "YAML file containing package names and counts")
47 <*> option auto (long "top-n" <> short 'n' <> help "How many of the top packages to build" <> showDefault <> value 100 <> metavar "INT")
48 <*> option auto (long "parallelism" <> short 'p' <> help "How many builds to run at once" <> showDefault <> value 10 <> metavar "INT")
49 <*> strOption (long "julia-attr" <> short 'a' <> help "Which Julia attr to build with" <> showDefault <> value "julia" <> metavar "STRING")
50
51data NameAndCount = NameAndCount {
52 name :: Text
53 , count :: Int
54 , uuid :: Text
55 } deriving (Show, Eq, Generic, FromJSON)
56
57newtype JuliaPath = JuliaPath FilePath
58 deriving Show
59
60julia :: Label "julia" (MVar (Maybe JuliaPath))
61julia = Label
62
63main :: IO ()
64main = do
65 clo <- parseCommandLineArgs argsParser (return ())
66 let args@(Args {..}) = optUserOptions clo
67
68 namesAndCounts :: [NameAndCount] <- Yaml.decodeFileEither countFilePath >>= \case
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
82miscTests :: Args -> SpecFree ctx IO ()
83miscTests args@(Args {..}) = describe "Misc tests" $ do
84 describe "works for a package outside the General registry" $ do
85 testExpr args "HelloWorld" [iii|(#{juliaAttr}.withPackages.override {
86 packageOverrides = {
87 "HelloWorld" = pkgs.fetchFromGitHub {
88 owner = "codedownio";
89 repo = "HelloWorld.jl";
90 rev = "9b41c55df76eb87830dd3bd0b5601ee2582a37c6";
91 sha256 = "sha256-G+xpMRb0RopW/xWA8KCFF/S8wuHTQbpj0qwm9CihfSc=";
92 };
93 };
94 }) [ "HelloWorld" ]|]
95
96 describe "misc cases" $ do
97 testExpr args "Optimization" [iii|(#{juliaAttr}.withPackages) [ "Optimization" "OptimizationOptimJL" ]|]
98
99-- * Low-level
100
101testExpr :: Args -> Text -> String -> SpecFree ctx IO ()
102testExpr _args name expr = do
103 introduce' (defaultNodeOptions { nodeOptionsVisibilityThreshold = 0 }) (T.unpack name) julia (newMVar Nothing) (const $ return ()) $ do
104 it "Builds" $ do
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))
114
115 it "Uses" $ do
116 getContext julia >>= readMVar >>= \case
117 Nothing -> expectationFailure "Build step failed."
118 Just (JuliaPath juliaPath) -> do
119 let cp = proc juliaPath ["-e", "using " <> T.unpack name]
120 createProcessWithLogging cp >>= waitForProcess >>= (`shouldBe` ExitSuccess)
121
122 where
123 aesonLookup :: Text -> HM.KeyMap v -> Maybe v
124 aesonLookup = HM.lookup . A.fromText
125
126claimRunSlot :: (HasParallelSemaphore ctx) => ExampleT ctx IO a -> ExampleT ctx IO ()
127claimRunSlot f = do
128 s <- getContext parallelSemaphore
129 bracket_ (liftIO $ waitQSem s) (liftIO $ signalQSem s) (void f)