day4.hs

import Data.List (inits, group)
import Data.List.Split

next :: String -> String
next n
  | descended && hasSequence a = a
  | hasSequence bumped = bumped
  | otherwise = next bumped
  where
    (a, descended) = makeAscending n
    (bumped, _) = makeAscending $ show $ (read a :: Int) + 1

isSorted :: Ord a => [a] -> Bool
isSorted [] = True
isSorted [x] = True
isSorted (h:a:t) = isSorted (a:t) && h <= a

getLargestSorted :: String -> String
getLargestSorted s = last $ takeWhile isSorted $ inits s

makeAscending :: String -> (String, Bool)
makeAscending l
  | length s < length l = (s ++ (replicate (length l - length s) $ last s), True)
  | otherwise = (l, False)
  where
    s = getLargestSorted l

hasSequence :: String -> Bool
hasSequence [x] = False
hasSequence (a:b:t) = a == b || hasSequence (b:t)

-- P2
hasSequencePt2 :: String -> Bool
hasSequencePt2 l = elem 2 $ length <$> group l

nextPt2 :: String -> String
nextPt2 n
  | descended && hasSequencePt2 a = a
  | hasSequencePt2 bumped = bumped
  | otherwise = nextPt2 bumped
  where
    (a, descended) = makeAscending n
    (bumped, _) = makeAscending $ show $ (read a :: Int) + 1

main :: IO ()
main = do
    [start,end] <- splitOn "-" <$> getLine

    putStrLn " -- Part 1 --"
    putStrLn $ show $ length $ tail $ takeWhile (\a -> (read a :: Int) < read end) $ iterate next start

    putStrLn " -- Part 2 --"
    putStrLn $ show $ length $ tail $ takeWhile (\a -> (read a :: Int) < read end) $ iterate nextPt2 start