Day 20

day20/Commons.hs

@@ -0,0 +1,49 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use tuple-section" #-}
+module Commons where
+
+import Data.List.Utils (split)
+import GHC.IO.Handle (isEOF)
+import Data.Map (Map, assocs, member, (!), fromList, empty, insert, toList, notMember)
+
+
+data Module = Broadcaster { outputs :: [String] } |
+              FlipFlop { state :: Bool, outputs :: [String] } |
+              Conjonction { inputs :: Map String Bool, outputs :: [String] } deriving (Show)
+type Modules = Map String Module
+
+
+parseModule :: String -> [String] -> (String, Module)
+parseModule "broadcaster" outputs = ("broadcaster", Broadcaster {outputs = outputs})
+parseModule ('%': name) outputs = (name, FlipFlop {state = False, outputs = outputs})
+parseModule ('&': name) outputs =
+  (name, Conjonction {inputs = empty, outputs = outputs})
+
+computeInputs'' :: String -> [String] -> Modules -> Modules
+computeInputs'' _ [] modules = modules
+computeInputs'' name (h: t) modules
+  | notMember h modules = computeInputs'' name t modules
+  | otherwise           =
+      let output = modules ! h
+      in case output of
+         Conjonction i o -> computeInputs'' name t $ insert h Conjonction {inputs = insert name False i, outputs = o}
+                                                            modules
+         _               -> computeInputs'' name t modules
+
+computeInputs' :: [(String, Module)] -> Modules -> Modules
+computeInputs' [] modules = modules
+computeInputs' ((name, m): t) modules = computeInputs' t $ computeInputs'' name (outputs m) modules
+
+computeInputs :: Modules -> Modules
+computeInputs modules = computeInputs' (toList modules) modules
+
+parseModules :: [(String, Module)] -> IO Modules
+parseModules otherModules = do done <- isEOF
+                               if done then return $ computeInputs $ fromList otherModules
+                               else do line <- getLine
+                                       let (rawName: rawOutputs: _) = split " -> " line
+                                       let cmodule = parseModule rawName $ split ", " rawOutputs
+                                       parseModules $ otherModules ++ [cmodule]
+
+parse :: IO Modules
+parse = parseModules []