Hylomorphism example

gistfile1.hs

{-# LANGUAGE DeriveFunctor #-}
import Data.Functor.Foldable
import qualified Data.Set as S

data Solve a x = Conquer a | Bottom | Divide x x deriving (Functor)

data Problem = Solution [Int] | Problem [([Int], S.Set Int)]

g n m = hylo phi psi $ Problem [([i], S.singleton i) | i <- [1..n-1]] where
	psi (Solution is) = Conquer is
	psi (Problem [])  = Bottom -- проблемы кончились
	psi (Problem [(is@(h:_), ms)]) -- одна задача - возможно, есть решение, и нужно бить на ещё две задачи
		| h < 0 || h >= n || length is > m = Bottom  -- на этих ветках дерева не будет решений
		| S.size ms == n = Divide (Solution $ reverse is) (Problem [((h-1):is, S.insert (h-1) ms), ((h+1):is, S.insert (h+1) ms)])  -- перепробованы все цифры - значит, как минимум решение, и бьём на две подзадачи
		| otherwise = Divide (Problem [((h-1):is, S.insert (h-1) ms)]) (Problem [((h+1):is, S.insert (h+1) ms)])
	psi (Problem (h:t)) = Divide (Problem [h]) (Problem t)

	phi Bottom = []
	phi (Conquer a) = [a]
	phi (Divide as bs) = as ++ bs