Code for generating solutions to the Add23 Puzzle

solutions.hs

solution target sides width pool = loop sides 0 []
  where
    loop 0 runningTotal accumulator = do
      let correct = (== sides + 2) . length . concatMap (uncurry intersect)
      guard . all correct . chunksOf sides . pairs $ accumulator
      return accumulator

    loop counter runningTotal accumulator = do
      current <- sumTo total width pool

      case accumulator of
        []              -> guard True
        (previous:_)    -> guard (last current <= last previous)

      let shares  = map (length . intersect current) accumulator

      guard $ all (< 2) shares
      guard $ sum shares <= 2
      guard $ runningTotal + sum shares <= 4

      loop (counter-1) (runningTotal + sum shares) (current:accumulator)