Constructing an action as a choice between all the permutations of some given actions (e.g. parsers), based on "Parsing Permutation Phrases", by Arthur Baars, Andres Loeh and S. Doaitse Swierstra, Haskell Workshop 2001.

This version has a slightly different interface from the paper.

This example (based on the paper) involves parsing XHTML img elements, which have a number of attributes, some optional, that may occur in any order, e.g.

<img alt="Lambda" src="lambda.jpg" width=20 height=50/>

We assume a data type for XHTML elements, with a constructor Img as one alternative:

data XHTML
   = ...
   | Img
        { src :: URI
        , alt :: Text
        , longdesc :: Maybe URI
        , height :: Maybe Length
        , width :: Maybe Length
        }

type Text = String
type URI = String
type Length = Int

Suppose we have a parser type Parser (an instance of Alternative) with primitive parsers:

pToken :: String -> Parser ()
pSymbol :: Char -> Parser ()
pText :: Parser Text
pURI :: Parser URI
pLength :: Parser Length

Then we can construct a parser for img elements as follows:

pImgTag :: Parser XHTML
pImgTag = pToken "<" *> pToken "img" *> attrs <* pToken "/>"
  where attrs = runPerms $ Img
                        <$> atom (pField "src" pURI)
                        <*> atom (pField "alt" pText)
                        <*> maybeAtom (pField "longdesc" pURI)
                        <*> maybeAtom (pField "height" pLength)
                        <*> maybeAtom (pField "width" pLength)

pField :: String -> Parser a -> Parser a
pField f p = pToken f *> pSymbol '=' *> p

Although permutations are particularly useful with parsers, they may also be used with other instances of Alternative.

For example, we can generate all the permutations of a list by permuting tell actions for the elements:

import Control.Monad.Writer (execWriterT, tell)
import Data.Foldable (sequenceA_)

permutations :: [a] -> [[a]]
permutations xs =
    execWriterT $ runPerms $ sequenceA_ [atom (tell [x]) | x <- xs]

Note that if each atomic action simply returned an element on the list, the result would be many copies of the original list, because the combinators ensure that the results are re-assembled in the original order, no matter what order the actions are executed.

We can also achieve a permutation of the integers 1 to n by using a permutation of effects that increment and return a state:

import Control.Monad.State (evalStateT, get, put)
import Data.Traversable (traverse)

permuteN :: Int -> [[Int]]
permuteN n = evalStateT (runPerms (traverse atom (replicate n incr))) 1
  where incr = do { n <- get; put (n+1); return n }

A solution to the n-queens problem is such a permutation satisfying the additional condition that no two positions are on the same diagonal. We can adapt the previous example to implement this idea by changing the state to a list of positions for the first n rows. Then when adding a new position we need only check that it is not on the same diagonal as the previous positions. If this test fails, the partial permutation will be discarded. Thus the algorithm is

import Control.Monad.State (evalStateT, get, put)
import Data.Traversable (traverse)

queens :: Int -> [[Int]]
queens n = evalStateT (runPerms (traverse (atom . place) [1..n])) []

where the auxiliary function place attempts to place a queen in a given position on the current row, returning the row number.

place :: Int -> StateT [Int] [] Int
place n = do
    ns <- get
    guard (and [abs (m-n) /= k | (k, m) <- zip [1..] ns])
    put (n:ns)
    return (length ns + 1)