[hs] Clean up 2020_09

hs/src/Aoc/Y2020/D09.hs

@@ -1,9 +1,15 @@
+{-# LANGUAGE RecordWildCards #-}
+
 module Aoc.Y2020.D09
   ( day
   ) where
 
 import           Control.Monad
+import           Data.Foldable
 import           Data.List
+import           Data.Maybe
+
+import qualified Data.Sequence as Seq
 
 import           Aoc.Day
 import           Aoc.Parse
@@ -25,15 +31,31 @@ isValid nums n = not $ null $ do
   guard $ a + b == n
   pure ()
 
--- Fast enough to give me a result, but not linear time. I couldn't figure out a
--- way to implement the linear time algorithm that didn't look like a mess.
--- Maybe I'll have another go for the cleanup.
-findRange :: Int -> [Int] -> [Int]
-findRange n
-  = head
-  . filter ((== n) . sum)
-  . map (head . dropWhile ((< n) . sum) . inits)
-  . tails
+data State = State
+  { sTarget :: Int
+  , sSeq    :: Seq.Seq Int
+  , sSum    :: Int
+  , sRest   :: [Int]
+  } deriving (Show)
+
+newState :: Int -> [Int] -> State
+newState target = State target Seq.empty 0
+
+step :: State -> Either (Maybe [Int]) State
+step s@State{..} = case compare sSum sTarget of
+  EQ -> Left $ Just $ toList sSeq
+  GT -> case Seq.viewl sSeq of
+    Seq.EmptyL  -> Left Nothing -- Should only happen if sTarget is negative
+    l Seq.:< ls -> Right s{ sSeq = ls, sSum = sSum - l }
+  LT -> case sRest of
+    []     -> Left Nothing -- Can happen if no sequence of correct sum is found
+    (r:rs) -> Right s{ sSeq = sSeq Seq.|> r, sSum = sSum + r, sRest = rs }
+
+untilLeft :: (b -> Either a b) -> b -> a
+untilLeft f a = either id (untilLeft f) $ f a
+
+findRange :: Int -> [Int] -> Maybe [Int]
+findRange target nums = untilLeft step $ newState target nums
 
 solver :: [Int] -> IO ()
 solver nums = do
@@ -43,7 +65,7 @@ solver nums = do
 
   putStrLn ""
   putStrLn ">> Part 2"
-  let weakness = findRange invalidN nums
+  let weakness = fromJust $ findRange invalidN nums
   print $ minimum weakness + maximum weakness
 
 day :: Day