Starting from my previous post, I add code to apply constraints as permutations are being generated.

```
type Constraints a = [(Int->Bool, [[a]->Bool])]
permute::Constraints a->[a]->[[a]]
permute cs xs = map fst $ permute' cs (length xs) [([],xs)]
-- The elements of the tuples are partial permutation and unallocated elements
permute'::Constraints a->Int->[([a],[a])] -> [([a],[a])]
permute' _ 0 xs = xs
permute' cs level xs =
permute' cs (level - 1) $
filter ((constraints cs level).fst) $
concat $ map permute'' xs
-- generate the next level of permutation of a single item
permute''::([a],[a])->[([a],[a])]
permute'' (xs,ys) = map (\(y,y')->((y:xs),y')) $ picks ys
-- generate all the ways to pick one item from a list
picks::[a]->[(a,[a])]
picks xs = map picks' $ splits xs
picks'::([a],[a]) -> (a,[a])
picks' (xs, ys) = ((head ys),(xs ++ tail ys))
-- generate all the ways to split a list
splits::[a]->[([a],[a])]
splits [] = []
splits (x:xs) = ([],x:xs):[(x:ls,rs) | (ls,rs)<-splits xs]
newtype Predicate a = Predicate {getPredicate::(a->Bool)} -- works as data or newtype
{- Before GHC 8.4, mappend (<>) was declared in Monoid. Semigroup is now a superclass of Monoid and the instances have to be declared separately. -}
instance Semigroup (Predicate a) where
(Predicate f) <> (Predicate g) = Predicate (\x->((f x) && (g x)))
instance Monoid (Predicate a) where
mempty = Predicate (\_->True)
-- combine all the constraints for this level
constraints :: Constraints a -> Int -> ([a]->Bool)
constraints cs level =
getPredicate $
foldMap Predicate $
concat $ map snd $
filter (\x -> (fst x) level) cs
-- constraints for magic square
-- note that permutations are built in reverse order, so most recently added element is first (x!!0)
-- and levels are built in descending order
msconstraints :: Constraints Int
msconstraints = [
((\x->elem x [7,4,1]),[\x->x!!0 == 15 - x!!1 - x!!2]), -- rows
((\x->elem x [3,2,1]),[\x->x!!0 == 15 - x!!3 - x!!6]), -- columns
((== 3), [\x->x!!0 == 15 - x!!2 - x!!4]), -- diagonal 1
((== 1), [\x->x!!0 == 15 - x!!4 - x!!8]), -- diagonal 2
-- redundant constraints included for efficiency
((== 5), [(\x->(5 == x!!0))]),
((== 9), [(\x->(even (x!!0)))]),
((\x->elem x [6,8]), [\x->(odd (x!!0)),
\x->(x!!0 /= 5)])
]
magicsquares = map (chop 3) $ permute msconstraints [1..9]
-- with redundant constraints (0.01 secs, 1,175,040 bytes)
-- without redundant constraints (0.08 secs, 16,050,864 bytes)
chop::Int->[a]->[[a]]
chop _ [] = []
chop n xs = (take n xs):(chop n $ drop n xs)
main :: IO ()
main = mapM_ (putStrLn . show) $ magicsquares
```

This is still faster than Tsoder’s brute force method, but slower than my list comprehension methods.

I like the way permutations and constraints are separated

I dislike the way the constraints are based on the recursion depth, which keeps changing. Perhaps a helper method to generate constraints from a more intuitive description would help.

Abstracting `Predicates`

out as a monoid does not simplify this program, but it is reusable. I think it could be better named, particularly as there could be similar monoids with the other boolean operators, by analogy with All and Any for simple booleans.

I called the method permute (a verb betraying my imperative background) which does not clash with Data.List.permutations, but perhaps the name should be closer.