Control.Applicative.Permutation

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.

Permutations of actions

data Perms p a

A representation of a permutation of actions of an Alternative type p. The value type of the composite action is a.

Permutations are constructed from the primitives atom, optAtom and maybeAtom, and combined using the methods of Functor and Applicative. They are converted back to composite actions using runPerms and runPermsSep.

The component actions of a permutation will be executed in each possible order, but the values they produce are always assembled in the order they occur in the program text, as in the following permutations of one, two or three component actions:

• runPerms (f <$> atom a) = f <$> a

• runPerms (f <$> atom a <*> atom b) = (f <$> a <*> b) <|> (flip f <$> b <*> a)

• runPerms (f <$> atom a <*> atom b <*> atom c) =
     ((\ x (y,z) -> f x y z) <$> a <*> ((,) <$> b <*> c) <|> (flip (,) <$> c <*> b)) <|>
     ((\ y (z,x) -> f x y z) <$> b <*> ((,) <$> a <*> c) <|> (flip (,) <$> c <*> a)) <|>
     ((\ z (x,y) -> f x y z) <$> c <*> ((,) <$> a <*> b) <|> (flip (,) <$> b <*> a))

The permutation is encoded as a tree, with the first action executed before the second selection is made. Thus failing actions, e.g. parsers, prune this tree. The size of the tree is exponential in the number of components, but it is constructed lazily.

Instances

Functor p => Functor (Perms p)

Alternative p => Applicative (Perms p)

Primitive permutations

atom :: Alternative p => p a -> Perms p a

A primitive permutation consisting of a single action.

• runPerms (atom a) = a

When building permutation parsers, the argument parser should not match the empty string: use optAtom or maybeAtom for optional elements.

optAtom :: Alternative p => a -> p a -> Perms p a

Like atom, but the action may be omitted from the permutation.

• runPerms (optAtom d p) = p <|> pure d

When building permutation parsers, the argument parser should not match the empty string.

maybeAtom :: Alternative p => p a -> Perms p (Maybe a)

Like atom, but the action may be omitted from the permutation.

• runPerms (maybeAtom p) = Just <$> p <|> pure Nothing

When building permutation parsers, the argument parser should not match the empty string.

Extracting permutation actions

runPerms :: Alternative p => Perms p a -> p a

Construct a permutation action.

• runPerms (pure x) = pure x

• runPerms (f <$> p) = f <$> runPerms p

runPermsSep :: Alternative p => p b -> Perms p a -> p a

runPermsSep sep p is similar to runPerms p, except that the action sep is interleaved between atomic actions in each permutation.

• runPermsSep sep (f <$> atom a) = f <$> a

• runPermsSep sep (f <$> atom a <*> atom b) = (f <$> a <* sep <*> b) <|> (flip f <$> b <* sep <*> a)

It is particularly useful in constructing permutation parsers, where sep might be a parser for a comma or other separator.

Parsing example

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

Other examples

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)