action-permutations (empty) → 0.0.0.0

raw patch · 4 files changed

+328/−0 lines, 4 filesdep +basedep +special-functorssetup-changed

Dependencies added: base, special-functors

Files

• Control/Applicative/Permutation.hs +266/−0
• LICENSE +31/−0
• Setup.hs +2/−0
• action-permutations.cabal +29/−0

@@ -0,0 +1,266 @@+{-# LANGUAGE ExistentialQuantification #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Control.Applicative.Permutation+-- Copyright   :  Ross Paterson 2009+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ross@soi.city.ac.uk+-- Stability   :  experimental+-- Portability :  existentials+--+-- 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.+-----------------------------------------------------------------------------++module Control.Applicative.Permutation (+    -- * Permutations of actions+    Perms,+    -- ** Primitive permutations+    atom,+    optAtom,+    maybeAtom,+    -- ** Extracting permutation actions+    runPerms,+    runPermsSep+    -- * Parsing example+    -- $example1++    -- * Other examples+    -- $example2+    ) where++import Control.Applicative (Applicative(..), Alternative(..), (<$>), (<$))++-- | 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.+data Perms p a = Choice (Maybe a) [Branch p a]+data Branch p a = forall b. Branch (Perms p (b -> a)) (p b)++instance Functor p => Functor (Perms p) where+    fmap f (Choice def bs) = Choice (fmap f def) (map (fmap f) bs)++instance Functor p => Functor (Branch p) where+    fmap f (Branch perm p) = Branch (fmap (f .) perm) p++-- These instances actually only need Applicative p, but we specify+-- Alternative for uniformity and to preserve the abstraction.++instance Alternative p => Applicative (Perms p) where+    pure v = Choice (Just v) []+    t1@(Choice d1 bs1) <*> t2@(Choice d2 bs2) =+        Choice (d1 <*> d2) (map ins2 bs1 ++ map ins1 bs2)+          where+            ins1 (Branch perm p) = Branch ((.) <$> t1 <*> perm) p+            ins2 (Branch perm p) = Branch (flip <$> perm <*> t2) p++instance Alternative p => Applicative (Branch p) where+    pure v = branch (pure v)+    Branch perm1 p1 <*> Branch perm2 p2 =+        Branch (lift_id <$> perm1 <*> perm2) ((,) <$> p1 <*> p2)++branch :: Alternative p => p a -> Branch p a+branch p = Branch (pure id) p++lift_id :: (a -> c -> r) -> (b -> c) -> (a,b) -> r+lift_id f g (x,y) = f x (g y)++-- Constructing primitive permutations.+-- The definitions of these three functions actually only require+-- Applicative p, but we specify Alternative for uniformity with+-- runPerms and runPermsSep, which are the only way to use the resulting+-- permutation.  Thus the interface hides the implementation detail of+-- where the Alternative methods are used.++-- | 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.+atom :: Alternative p => p a -> Perms p a+atom p = Choice Nothing [branch p]++-- | 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.+optAtom :: Alternative p => a -> p a -> Perms p a+optAtom def p = Choice (Just def) [branch p]++-- | 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.+maybeAtom :: Alternative p => p a -> Perms p (Maybe a)+maybeAtom p = optAtom Nothing (Just <$> p)++-- Extracting a permutation action from a permutation tree++-- | Construct a permutation action.+--+-- * @'runPerms' ('pure' x) = 'pure' x@+--+-- * @'runPerms' (f '<$>' p) = f '<$>' 'runPerms' p@+runPerms :: Alternative p => Perms p a -> p a +runPerms = foldChoice pars+  where pars (Branch t p) = flip ($) <$> p <*> runPerms t+-- NOT: pars (Branch t p) = runPerms t <*> p++-- | @'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 persers, where+-- @sep@ might be a parser for a comma or other separator.+runPermsSep :: Alternative p => p b -> Perms p a -> p a +runPermsSep sep = foldChoice pars+  where pars (Branch t p) = flip ($) <$> p <*> runPermsPref sep t++runPermsPref :: Alternative p => p b -> Perms p a -> p a +runPermsPref sep = foldChoice pars+  where pars (Branch t p) = flip ($) <$ sep <*> p <*> runPermsPref sep t++foldChoice :: Alternative p => (Branch p a -> p a) -> Perms p a -> p a+foldChoice f (Choice d bs) = foldr ((<|>) . f) (maybe empty pure d) bs++{- $example1++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++-}++{- $example2++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)++-}

@@ -0,0 +1,31 @@+The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH+DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,29 @@+name:         action-permutations+version:      0.0.0.0+license:      BSD3+license-file: LICENSE+author:       Ross Paterson <ross@soi.city.ac.uk>+maintainer:   Ross Paterson <ross@soi.city.ac.uk>+category:     Control+synopsis:     Execute a set of actions (e.g. parsers) in each possible order+description:+    Sequence a set of Alternative actions in each possible order,+    based on \"Parsing Permutation Phrases\", by Arthur Baars,+    Andres Loeh and S. Doaitse Swierstra, /Haskell Workshop 2001/.+    This is particularly useful for constructing a parser for+    permutations of elements.+    This version has a slightly different interface from the paper.+build-type: Simple+cabal-version: >= 1.2++flag ApplicativeInBase+  description: Choose the newer base package, including Applicative and other+    Functor classes.++library+  if flag(ApplicativeInBase)+    build-depends: base >= 2+  else+    build-depends: base >= 1.0 && < 2, special-functors >=1.0 && <1.1+  exposed-modules: Control.Applicative.Permutation+  extensions: ExistentialQuantification