Day 1

2024/.gitignore

@@ -0,0 +1 @@
+dist-newstyle/

2024/app/Day1-example.txt

@@ -0,0 +1,6 @@
+3   4
+4   3
+2   5
+1   3
+3   9
+3   3

2024/app/Day1.hs

@@ -0,0 +1,54 @@
+module Day1 where
+
+import Data.List
+import ParseLib
+import Util
+
+main :: IO ()
+main = do
+  example <- getFileContents "app/Day1-example.txt"
+  input <- getFileContents "app/Day1-input.txt"
+
+  putStrLn "Part 1"
+  putStrLn $ "Example: " ++ show (part1 example)
+  putStrLn $ "Input:   " ++ show (part1 input)
+  putStrLn ""
+  putStrLn "Part 2"
+  putStrLn $ "Example: " ++ show (part2 example)
+  putStrLn $ "Input:   " ++ show (part2 input)
+
+part1 :: String -> Int
+part1 input = sum
+  $ fmap (unwrap . foldMap Difference)
+  $ getPairwise
+  $ traverse (Pairwise . sort)
+  $ sequenceA
+  $ tryparse lexer input
+
+part2 :: String -> Int
+part2 input = sum $ fmap (\x -> x * count list2 x) list1
+  where Line list1 list2 = sequenceA (tryparse lexer input)
+
+
+data Line a = Line a a deriving (Show)
+
+-- Parser code
+
+lexer :: Parser Char [Line Int]
+lexer = greedy parseLine
+
+parseLine :: Parser Char (Line Int)
+parseLine = Line <$$> natural <$* token "   " <$*> natural <$* token "\n"
+
+instance Functor Line where
+  fmap f (Line x y) = Line (f x) (f y)
+
+instance Applicative Line where
+  pure x = Line x x
+  (<*>) (Line fx fy) (Line x y) = Line (fx x) (fy y)
+
+instance Foldable Line where
+  foldMap f (Line x y) = f x `mappend` f y
+
+instance Traversable Line where
+  traverse f (Line x y) = liftA2 Line (f x) (f y)

2024/app/Main.hs

@@ -0,0 +1,7 @@
+module Main where
+
+import Day1
+
+main :: IO ()
+main = do
+    Day1.main

2024/app/Util.hs

@@ -0,0 +1,65 @@
+module Util where
+
+import ParseLib ( (<$>), (<*>), (<*), (*>), (<$), Parser, parse )
+import System.IO ( IOMode(ReadMode), openFile, hGetContents )
+
+-- Functions on lists
+
+count :: Eq a => [a] -> a -> Int
+count xs find = length (filter (== find) xs)
+
+-- Helper IO functions
+
+getFileContents :: FilePath -> IO String
+getFileContents filename = do
+  handle <- openFile filename ReadMode
+  hGetContents handle
+
+-- Helper functions for the utrecht parser combinator lib
+-- Rename operators
+
+(<$$>) :: (a -> b) -> Parser s a -> Parser s b
+(<$$>) = (ParseLib.<$>)
+
+(<$$) :: b -> Parser s a -> Parser s b
+(<$$) = (ParseLib.<$)
+
+(<$*>) :: Parser s (b -> a) -> Parser s b -> Parser s a
+(<$*>) = (ParseLib.<*>)
+
+(<$*) :: Parser s a -> Parser s b -> Parser s a
+(<$*) = (ParseLib.<*)
+
+($*>) :: Parser s a -> Parser s b -> Parser s b
+($*>) = (ParseLib.*>)
+
+tryparse :: Parser s a -> [s] -> a
+tryparse lexer input = case parse lexer input of
+      (ls : _) -> fst ls
+      _ -> error "Parsing failed"
+
+
+-- A monoid that calculates the difference between two numbers
+
+newtype Difference a = Difference {unwrap :: a} deriving (Show)
+
+instance (Num a) => Semigroup (Difference a) where
+  (<>) (Difference a) (Difference b) = Difference (abs $ b - a)
+
+instance (Num a) => Monoid (Difference a) where
+  mempty = Difference 0
+
+
+-- List's applicative fmap creates a "cartesian" product.
+-- This applies the functor pairwise (which is what you usually want?)
+
+newtype Pairwise a = Pairwise {getPairwise :: [a]} deriving (Show)
+
+instance Functor (Pairwise) where
+  fmap f (Pairwise as) = Pairwise $ fmap f as
+
+instance Applicative (Pairwise) where
+  pure x = Pairwise (pure x)
+
+  (<*>) (Pairwise fs) (Pairwise xs) =
+    Pairwise (zipWith ($) fs xs)

2024/flake.lock

@@ -0,0 +1,61 @@
+{
+  "nodes": {
+    "flake-utils": {
+      "inputs": {
+        "systems": "systems"
+      },
+      "locked": {
+        "lastModified": 1731533236,
+        "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1732837521,
+        "narHash": "sha256-jNRNr49UiuIwaarqijgdTR2qLPifxsVhlJrKzQ8XUIE=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "970e93b9f82e2a0f3675757eb0bfc73297cc6370",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "flake-utils": "flake-utils",
+        "nixpkgs": "nixpkgs"
+      }
+    },
+    "systems": {
+      "locked": {
+        "lastModified": 1681028828,
+        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+        "owner": "nix-systems",
+        "repo": "default",
+        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-systems",
+        "repo": "default",
+        "type": "github"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

2024/flake.nix

@@ -0,0 +1,27 @@
+{
+  description = "";
+
+  inputs = {
+    flake-utils.url = "github:numtide/flake-utils";
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+
+  };
+
+  outputs = { nixpkgs, flake-utils, ... }:
+    flake-utils.lib.eachDefaultSystem (system:
+      let pkgs = nixpkgs.legacyPackages.${system};
+      in {
+        packages = { default = { }; };
+
+        devShells.default = pkgs.mkShell {
+          packages = with pkgs; [
+            git
+            gcc11
+            cabal-install
+            ghc
+            haskellPackages.haskell-language-server
+          ];
+        };
+      });
+}
+

2024/x2024.cabal

@@ -0,0 +1,17 @@
+cabal-version:      3.4
+name:               x2024
+version:            0.1.0.0
+build-type:         Simple
+extra-doc-files:    CHANGELOG.md
+
+common warnings
+    ghc-options: -Wall
+
+executable x2024
+    import:           warnings
+    main-is:          Main.hs
+    other-modules:    Util, Day1
+    -- other-extensions:
+    build-depends:    base ^>=4.18.2.1, uu-tc, containers
+    hs-source-dirs:   app
+    default-language: Haskell2010