diff --git a/.github/workflows/tests.yaml b/.github/workflows/tests.yaml index 4eb071d..db764dd 100644 --- a/.github/workflows/tests.yaml +++ b/.github/workflows/tests.yaml @@ -27,7 +27,7 @@ jobs: - uses: actions/checkout@v3 - name: Install Nix - uses: DeterminateSystems/nix-installer-action@v4 + uses: cachix/install-nix-action@v31.7.0 - name: Check Cachix token exists env: @@ -39,7 +39,7 @@ jobs: fi - name: Setup cachix cache - uses: cachix/cachix-action@v12 + uses: cachix/cachix-action@v16 with: name: draftgen authToken: "${{ secrets.CACHIX_AUTH_TOKEN }}" @@ -61,17 +61,20 @@ jobs: nix flake check nix run .#check-formatting - - name: Check Haskell formatting - uses: haskell-actions/run-fourmolu@v11 - with: - version: "0.15.0.0" - pattern: | - src/**/*.hs - prelude/**/*.hs - test/**/*.hs - - # Don't follow symbolic links to .hs files. - follow-symbolic-links: false + # Idk seems broken, and doesn't even print output from fourmolu + # if it the formatting check fails + # + # - name: Check Haskell formatting + # uses: haskell-actions/run-fourmolu@v11 + # with: + # version: "0.15.0.0" + # pattern: | + # src/**/*.hs + # prelude/**/*.hs + # test/**/*.hs + + # # Don't follow symbolic links to .hs files. + # follow-symbolic-links: false - name: Update cabal packages run: nix develop -c cabal update diff --git a/DraftGen.cabal b/DraftGen.cabal index a3b89ac..7b570a4 100644 --- a/DraftGen.cabal +++ b/DraftGen.cabal @@ -95,6 +95,7 @@ test-suite unit-tests build-depends: , aeson , base ^>=4.19.2.0 + , containers , dg-prelude , DraftGen , exceptions diff --git a/flake.nix b/flake.nix index 5d49eae..b988822 100644 --- a/flake.nix +++ b/flake.nix @@ -52,15 +52,15 @@ in "${script}/bin/${name}"; }; devShells.default = let - tools = with hpkgs; - [ + tools = + (with hpkgs; [ cabal-fmt cabal-install fourmolu ghc ghc-prof-flamegraph profiteur - ] + ]) ++ (with pkgs; [ ghciwatch haskell-language-server diff --git a/src/DraftGen/File.hs b/src/DraftGen/File.hs index 40f95f4..9c08e46 100644 --- a/src/DraftGen/File.hs +++ b/src/DraftGen/File.hs @@ -7,7 +7,7 @@ Module for handling reading from and writing to files -} -module File (execute, run) where +module File (execute, getFromCache, run) where import CLI qualified import Control.Concurrent.Async qualified as Async @@ -102,7 +102,7 @@ fetchSet set = do setInfoRes <- liftIO $ getScryfall manager ("https://api.scryfall.com/sets" set) [] setInfo <- ExceptT . pure $ Json.eitherDecode @SetInfo setInfoRes.responseBody let pages :: [Int] = - enumFromTo 1 $ ceiling $ fromIntegral @_ @Double setInfo.cardCount / 175 + enumFromTo 1 . succ $ setInfo.cardCount `div` 175 getSetData page = getScryfall manager diff --git a/src/DraftGen/Generate.hs b/src/DraftGen/Generate.hs index bd2607e..3c0528b 100644 --- a/src/DraftGen/Generate.hs +++ b/src/DraftGen/Generate.hs @@ -11,6 +11,7 @@ module Generate ( encodeFile , filterBySet , genLands + , genPack , genPacks , genTokens , readCards @@ -73,7 +74,6 @@ filterDesired = S.filter $ \card -> [ \card -> card.layout `notElem` unwantedLayout , \card -> null $ card.frameEffects `intersect` unwantedFrameEffects , \card -> not card.variation - , \card -> not card.reprint , \card -> not card.fullArt , \card -> not card.promo , \card -> card.borderColor /= ColorBorderless @@ -165,13 +165,13 @@ genTokens config = pure . filterBySet ('t' : config.set) -- | Generate a random pack based on the pack configuration genPack :: PackConfig -> HashSet CardObj -> IO (Seq CardObj) -genPack config cards = +genPack config setCards = if config.set == "stx" - then genStrixhavenPack config cards + then genStrixhavenPack config setCards else do - let setCards = english . filterBySet config.set . filterDesired $ cards - base = filterBasicLands Out setCards - english = S.filter (\c -> c.lang == "en") + let english = S.filter (\c -> c.lang == "en") + desiredCards = english . filterDesired $ setCards + base = filterBasicLands Out desiredCards fbr r = filterByRarity r base foils = S.filter (.foil) base commonWithMaybeFoilCards <- @@ -187,10 +187,10 @@ fromSets = foldr ((Sq.><) . Sq.fromList . S.toList) Sq.empty -- | Generate a strixhaven pack (has special rules) genStrixhavenPack :: PackConfig -> HashSet CardObj -> IO (Seq CardObj) genStrixhavenPack config cards = do - let stxCards = english . filterBySet config.set . filterDesired $ cards + let stxCards = english . filterDesired $ cards baseNoLesson = filterLesson Out . filterBasicLands Out $ stxCards lessons = filterLesson In stxCards - staCards = english . filterBySet "sta" $ cards + staCards = english cards english = S.filter (\card -> card.lang == "en") fbr r = filterByRarity r baseNoLesson foils = S.filter (.foil) baseNoLesson diff --git a/test/src/Main.hs b/test/src/Main.hs index 417c314..1e85e4b 100644 --- a/test/src/Main.hs +++ b/test/src/Main.hs @@ -12,12 +12,15 @@ module Main where import CLI import Control.Monad.Catch import Control.Monad.IO.Class -import Control.Monad.Trans.Except (runExceptT) +import Control.Monad.Trans.Except (ExceptT (..), runExceptT) import Data.Aeson qualified as Json import Data.HashSet (HashSet) import Data.HashSet qualified as HS -import File (run) +import Data.Sequence (Seq) +import Data.Sequence qualified as Seq +import File qualified import Generate (filterDesired, readCards) +import Generate qualified import System.FilePath import Test.Sandwich import Types @@ -66,8 +69,10 @@ testFrameEffectInverse = encodeDecodeIsInverse CompassLandDfc testBorderColorInverse :: (MonadIO m, MonadThrow m) => m () testBorderColorInverse = encodeDecodeIsInverse ColorBlack -genPacks :: (MonadIO m, MonadThrow m) => m () -genPacks = runExceptT (run config) *> shouldBe True True +-- | Simulate running DraftGen from the command line +-- This function generates packs, encodes and writes them to the file system. +simulateMain :: (MonadIO m, MonadThrow m) => m () +simulateMain = runExceptT (File.run config) *> shouldBe True True where config = PackConfig @@ -80,13 +85,37 @@ genPacks = runExceptT (run config) *> shouldBe True True , foilChance = Ratio 1 45 } +generatePack :: MonadIO m => PackConfig -> ExceptT String m (Seq CardObj) +generatePack config = do + cards <- File.getFromCache config.set + liftIO $ Generate.genPack config cards + +generatesValidPack :: (MonadIO m, MonadThrow m) => m () +generatesValidPack = do + packRes <- runExceptT $ generatePack config + case packRes of + Left err -> expectationFailure err + Right pack -> Seq.length pack `shouldBe` (config.commons + config.uncommons + config.rareOrMythics) + where + config = + PackConfig + { amount = 6 + , set = "om1" + , commons = 10 + , uncommons = 3 + , rareOrMythics = 1 + , mythicChance = Ratio 1 8 + , foilChance = Ratio 1 45 + } + basic :: TopSpec basic = describe "Unit tests" $ do it "filterDesired filters out undesired card types" testFilterDesired it "cardFace encode/decode are inverses" testCardFaceInverse it "frameEffect encode/decode are inverses" testFrameEffectInverse it "borderColor encode/decode are inverses" testBorderColorInverse - it "generates packs without throwing exceptions" genPacks + it "generates a valid pack with the expected contents" generatesValidPack + it "generates packs without throwing exceptions" simulateMain main :: IO () main = runSandwichWithCommandLineArgs defaultOptions basic