Day 3

src/Day3/Part1.hs

@@ -0,0 +1,30 @@
+module Day3.Part1 (
+  splitContents,
+  itemsInBoth,
+  itemPriority,
+  priority,
+  rearrangementPriority,
+)
+where
+
+import qualified Data.Set as Set
+import Day3.Shared
+
+
+splitContents :: Contents -> (Contents, Contents)
+splitContents c = splitAt middle c
+  where
+    middle = length c `div` 2
+
+itemsInBoth :: Contents -> Contents
+itemsInBoth cs = Set.toList $ leftSet `Set.intersection` rightSet
+  where
+    (left, right) = splitContents cs
+    leftSet = Set.fromList left
+    rightSet = Set.fromList right
+
+rearrangementPriority :: String -> Int
+rearrangementPriority input = sum priorities
+  where
+    contents = lines input
+    priorities = map (priority . itemsInBoth) contents

src/Day3/Part2.hs

@@ -0,0 +1,32 @@
+module Day3.Part2 (
+  splitIntoGroups,
+  badgeOfGroup,
+  sumOfBadgePriorities,
+)
+where
+
+import Day3.Shared
+import Data.List.Split
+import qualified Data.Set as Set
+import Control.Lens
+
+type Group = (Contents, Contents, Contents)
+type Badge = Char
+
+splitIntoGroups :: String -> [Group]
+splitIntoGroups =  map asTriple . chunksOf 3 . lines
+
+asTriple :: [Contents] -> Group
+asTriple ls = (head ls, ls !! 1, ls !! 2)
+
+badgeOfGroup :: Group -> Badge
+badgeOfGroup g = inAll
+  where
+    (a, b, c) = over each Set.fromList g
+    inAll = head . Set.elems $ a `Set.intersection` b `Set.intersection` c
+
+sumOfBadgePriorities :: String -> Int
+sumOfBadgePriorities input = maybeSum $ map itemPriority badges
+  where
+    badges = map badgeOfGroup $ splitIntoGroups input
+    

src/Day3/Shared.hs

@@ -0,0 +1,31 @@
+module Day3.Shared (
+   Contents,
+   Item,
+   itemPriority,
+   priority,
+   maybeSum
+   )
+ where
+import qualified Data.Map as Map
+
+type Contents = String
+type Item = Char
+
+
+
+itemPriority :: Item -> Maybe Int
+itemPriority = flip Map.lookup itemMap
+  where
+  itemMap = Map.fromList $ (['a' .. 'z'] ++ ['A' .. 'Z']) `zip` [1 .. 52]
+
+addMaybe :: Int -> Maybe Int -> Int
+addMaybe acc Nothing = acc
+addMaybe acc (Just y) = acc + y
+
+maybeSum :: [Maybe Int] -> Int
+maybeSum = foldl addMaybe 0
+
+priority :: Contents -> Int
+priority cs = maybeSum prioList
+  where
+    prioList = map itemPriority cs