From 359aee0f229ec374a6ce91752ab2b5dcd9932409 Mon Sep 17 00:00:00 2001 From: ctsk <9384305+ctsk@users.noreply.github.com> Date: Wed, 30 Aug 2023 09:32:12 +0200 Subject: [PATCH] Reorganize imports --- Y2022.cabal | 36 +++++++++++++++------- app/Main.hs | 18 +++++------ bench/Bench.hs | 9 ++++++ src/Common.hs | 28 ++++++++++++++++++ src/Days/D01.hs | 5 ++-- src/Days/D02.hs | 79 ++++++++++++++++++++++++------------------------- src/Days/D03.hs | 5 ++-- src/Lib.hs | 62 +++++++++++--------------------------- src/Parse.hs | 24 +++++++++++++-- src/Print.hs | 2 +- 10 files changed, 153 insertions(+), 115 deletions(-) create mode 100644 bench/Bench.hs create mode 100644 src/Common.hs diff --git a/Y2022.cabal b/Y2022.cabal index c9ab74e..1cdda3a 100644 --- a/Y2022.cabal +++ b/Y2022.cabal @@ -12,31 +12,45 @@ source-repository head location: https://github.com/ctsk/aoc-2022 common warnings - ghc-options: -Wall -O2 -ddump-simpl -ddump-to-file + ghc-options: -Wall + +common defaults + default-language: Haskell2010 + build-depends: + base ^>=4.18.0.0 + , extra ^>=1.7.14 + , containers + library - default-language: Haskell2010 + import: warnings, defaults hs-source-dirs: src - ghc-options: -Wall -O2 -ddump-simpl -ddump-to-file exposed-modules: Lib - Print + other-modules: + Common Parse + Print Util Days.D01 Days.D02 Days.D03 build-depends: - base ^>=4.18.0.0 - , extra ^>=1.7.14 - , megaparsec ^>=9.4.0 + megaparsec ^>=9.4.0 , text executable Y2022 - import: warnings + import: warnings, defaults + hs-source-dirs: app main-is: Main.hs build-depends: Y2022 - , base ^>=4.18.0.0 - hs-source-dirs: app - default-language: Haskell2010 + +benchmark Y2022-bench + import: defaults + type: exitcode-stdio-1.0 + hs-source-dirs: bench + main-is: Bench.hs + build-depends: + Y2022 + , criterion ^>=1.6.3.0 \ No newline at end of file diff --git a/app/Main.hs b/app/Main.hs index 02052f2..7e5969d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -3,21 +3,19 @@ module Main where import Lib -import Print - -import qualified Days.D01 as D01 -import qualified Days.D02 as D02 -import qualified Days.D03 as D03 import System.Environment (getArgs) -solutions :: [(Int, Day, FilePath)] -solutions = - [ (1, D01.day, "./data/01.in") - , (2, D02.day, "./data/02.in") - , (3, D03.day, "./data/03.in") +paths :: [FilePath] +paths = + [ "./data/01.in" + , "./data/02.in" + , "./data/03.in" ] +solutions :: [(Int, Day, FilePath)] +solutions = zip3 [1 ..] (map head days) paths + runAll :: [(Int, Day, FilePath)] -> IO () runAll = mapM_ (\(dayNum, day, path) -> run day path >>= printDR dayNum) diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 index 0000000..93f615b --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,9 @@ +module Main where + +import Criterion (bench, whnfIO) +import Criterion.Main (defaultMain) + +main = + defaultMain + [ bench "whnfIO readFile" $ whnfIO (readFile "Y2022.cabal") + ] \ No newline at end of file diff --git a/src/Common.hs b/src/Common.hs new file mode 100644 index 0000000..15e3ee1 --- /dev/null +++ b/src/Common.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ImportQualifiedPost #-} + +module Common where + +import Data.Text qualified as T + +data Answer where + Answer :: (Show a) => a -> Answer + +instance Show Answer where + showsPrec p (Answer a) = showsPrec p a + +data PuzzleError + = MalformedInput String + | Unsolvable + +type Result = Maybe Answer + +definitive :: (Show a) => a -> Result +definitive = Just . Answer + +type DayResult = Either String (Result, Result) + +data Day + = TextDay (T.Text -> DayResult) + | StringDay (String -> DayResult) + | ParsecDay (FilePath -> T.Text -> DayResult) diff --git a/src/Days/D01.hs b/src/Days/D01.hs index 2040e82..2f10140 100644 --- a/src/Days/D01.hs +++ b/src/Days/D01.hs @@ -1,9 +1,8 @@ module Days.D01 where -import Lib (Day, Parser, definitive, parsecDay) -import Parse (number, someLines) - +import Common import Data.List (sortBy) +import Parse type Intermediate = [[Int]] diff --git a/src/Days/D02.hs b/src/Days/D02.hs index 8437932..80b64f5 100644 --- a/src/Days/D02.hs +++ b/src/Days/D02.hs @@ -3,10 +3,9 @@ module Days.D02 where -import Lib -import Parse - +import Common import Data.Functor ((<&>)) +import Parse import Text.Megaparsec (oneOf) import Text.Megaparsec.Char (space) @@ -18,23 +17,23 @@ type Intermediate = [(Play, Guide)] parser :: Parser Intermediate parser = someLines line - where - line :: Parser (Play, Guide) - line = (,) <$> elf <* space <*> guide + where + line :: Parser (Play, Guide) + line = (,) <$> elf <* space <*> guide - elf :: Parser Play - elf = - oneOf "ABC" <&> \case - 'A' -> Rock - 'B' -> Paper - 'C' -> Scissors + elf :: Parser Play + elf = + oneOf "ABC" <&> \case + 'A' -> Rock + 'B' -> Paper + 'C' -> Scissors - guide :: Parser Guide - guide = - oneOf "XYZ" <&> \case - 'X' -> X - 'Y' -> Y - 'Z' -> Z + guide :: Parser Guide + guide = + oneOf "XYZ" <&> \case + 'X' -> X + 'Y' -> Y + 'Z' -> Z playScore :: Play -> Int playScore = (1 +) . fromEnum @@ -47,33 +46,33 @@ convert = toEnum . fromEnum part1 :: Intermediate -> Int part1 = sum . map f - where - f (elf, guide) = let us = convert guide in playScore us + winScore (outcome elf us) + where + f (elf, guide) = let us = convert guide in playScore us + winScore (outcome elf us) - outcome :: Play -> Play -> Outcome - outcome Rock Rock = Draw - outcome Rock Paper = Win - outcome Rock Scissors = Loss - outcome Paper Rock = Loss - outcome Paper Paper = Draw - outcome Paper Scissors = Win - outcome Scissors Rock = Win - outcome Scissors Paper = Loss - outcome Scissors Scissors = Draw + outcome :: Play -> Play -> Outcome + outcome Rock Rock = Draw + outcome Rock Paper = Win + outcome Rock Scissors = Loss + outcome Paper Rock = Loss + outcome Paper Paper = Draw + outcome Paper Scissors = Win + outcome Scissors Rock = Win + outcome Scissors Paper = Loss + outcome Scissors Scissors = Draw part2 :: Intermediate -> Int part2 = sum . map f - where - f (elf, guide) = let us = convert guide in winScore us + playScore (counter us elf) + where + f (elf, guide) = let us = convert guide in winScore us + playScore (counter us elf) - counter :: Outcome -> Play -> Play - counter Draw e = e - counter Win Rock = Paper - counter Win Paper = Scissors - counter Win Scissors = Rock - counter Loss Rock = Scissors - counter Loss Paper = Rock - counter Loss Scissors = Paper + counter :: Outcome -> Play -> Play + counter Draw e = e + counter Win Rock = Paper + counter Win Paper = Scissors + counter Win Scissors = Rock + counter Loss Rock = Scissors + counter Loss Paper = Rock + counter Loss Scissors = Paper day :: Day day = parsecDay parser (definitive . part1, definitive . part2) \ No newline at end of file diff --git a/src/Days/D03.hs b/src/Days/D03.hs index 8b5df73..dbc98ee 100644 --- a/src/Days/D03.hs +++ b/src/Days/D03.hs @@ -1,11 +1,10 @@ -{-# LANGUAGE ImportQualifiedPost #-} - module Days.D03 where +import Common + import Data.Char (ord) import Data.List (intersect) import Data.List.Extra (chunksOf) -import Lib (Day (StringDay), definitive) type Intermediate = [String] diff --git a/src/Lib.hs b/src/Lib.hs index daf8a09..fe1c29e 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,55 +1,29 @@ -{-# LANGUAGE ExistentialQuantification #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE ImportQualifiedPost #-} -module Lib where +module Lib ( + run, + Day, + days, + printDR, +) where -import Util (both) +import Common (Day (..), DayResult) +import Print (printDR) + +import Days.D01 qualified as D01 +import Days.D02 qualified as D02 +import Days.D03 qualified as D03 -import Data.Function ((&)) -import Data.Text qualified as T import Data.Text.IO qualified as T -import Data.Void (Void) -import Text.Megaparsec qualified as M (Parsec, eof, errorBundlePretty, parse) - -data Answer where - Answer :: (Show a) => a -> Answer - -instance Show Answer where - showsPrec p (Answer a) = showsPrec p a - -data PuzzleError - = MalformedInput String - | Unsolvable - -type Result = Maybe Answer - -definitive :: (Show a) => a -> Result -definitive = Just . Answer - -type DayResult = Either String (Result, Result) - -data Day - = TextDay (T.Text -> DayResult) - | StringDay (String -> DayResult) - | ParsecDay (FilePath -> T.Text -> DayResult) run :: Day -> FilePath -> IO DayResult run (TextDay f) = fmap f . T.readFile run (StringDay f) = fmap f . readFile run (ParsecDay f) = \path -> f path <$> T.readFile path -type Parser = M.Parsec Void T.Text - -parsecDay :: - Parser a -> - (a -> Result, a -> Result) -> - Day -parsecDay parser parts = - ParsecDay - ( \path text -> - ( case M.parse (parser <* M.eof) path text of - Left e -> Left $ M.errorBundlePretty e - Right parsedInput -> Right $ both (parsedInput &) parts - ) - ) +days :: [[Day]] +days = + [ [D01.day] + , [D02.day] + , [D03.day] + ] diff --git a/src/Parse.hs b/src/Parse.hs index 9979528..b35e887 100644 --- a/src/Parse.hs +++ b/src/Parse.hs @@ -2,14 +2,32 @@ module Parse where -import Lib (Parser) - +import Common +import Data.Function ((&)) +import Data.Text qualified as T +import Data.Void import Text.Megaparsec qualified as M import Text.Megaparsec.Char qualified as MC import Text.Megaparsec.Char.Lexer qualified as MCL +import Util (both) someLines :: Parser a -> Parser [a] someLines p = p `M.sepEndBy1` MC.newline number :: Parser Int -number = MCL.decimal \ No newline at end of file +number = MCL.decimal + +type Parser = M.Parsec Void T.Text + +parsecDay :: + Parser a -> + (a -> Result, a -> Result) -> + Day +parsecDay parser parts = + ParsecDay + ( \path text -> + ( case M.parse (parser <* M.eof) path text of + Left e -> Left $ M.errorBundlePretty e + Right parsedInput -> Right $ both (parsedInput &) parts + ) + ) diff --git a/src/Print.hs b/src/Print.hs index c0e30c0..2d023f1 100644 --- a/src/Print.hs +++ b/src/Print.hs @@ -1,6 +1,6 @@ module Print where -import Lib (DayResult) +import Common import Text.Printf (printf) printDR :: Int -> DayResult -> IO ()