PermuteEffects (empty) → 0.1

raw patch · 4 files changed

+254/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

• Control/Applicative/Permute.hs +164/−0
• LICENSE +30/−0
• PermuteEffects.cabal +58/−0
• Setup.hs +2/−0

@@ -0,0 +1,164 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Control.Applicative.Permute+  ( Effects, perms++  -- * Lifting computations+  , once, opt, atLeast, between, exactly, many, some++  ) where++import Prelude hiding (length, sequence)+import Control.Applicative hiding (some, many)+import Data.Foldable++-- | A chain of effectful @f@-computations with final result @a@. Individual+-- computations (lifted into @Effects@ using one of the frequency combinators+-- below) have their own result types, which fit together in standard+-- 'Applicative' fashion. Although these result types are existentially+-- quantified, the computations can still be moved around within the list (see+-- 'swap' and 'firsts' in the source code for examples). This allows their+-- permutations to be computed.+data Effects f a where+  Nil  :: a -> Effects f a+  (:-) :: Freq f b -> Effects f (b -> a) -> Effects f a++infixr 5 :-++-- | Used to indicate the frequency of a computation in a single permutation,+-- changing the result type accordingly.+data Freq f a where+  Once    ::               f a -> Freq f a+  Opt     ::               f a -> Freq f (Maybe a)+  AtLeast :: Int ->        f a -> Freq f [a]+  Between :: Int -> Int -> f a -> Freq f [a]++-- | Map over the final result type.+instance Functor (Effects f) where+  fmap f (Nil x) = Nil (f x)+  fmap f (p :- ps) = p :- fmap (fmap f) ps++-- | 'pure' represents the empty list of computations while '<*>' acts like+-- '++'.+instance Applicative (Effects f) where+  pure = Nil+  Nil g <*> y = fmap g y+  (f :- x) <*> y = f :- (flip <$> x <*> y)++-- | Compute the length of a list of computations.+length :: Effects f a -> Int+length (Nil _)     = 0+length (_ :- xs) = 1 + length xs++-- | Run a computation with a certain frequency.+runFreq :: Alternative f => Freq f a -> f a+runFreq freq =+  case freq of+    Once p        -> p+    Opt  p        -> Just <$> p <|> pure Nothing+    AtLeast 0 _   -> pure []+    AtLeast n p   -> (:) <$> p <*> runFreq (AtLeast (n - 1) p)+    Between 0 0 _ -> pure []+    Between 0 m p -> runFreq (Between 0 (m - 1) p) <|> pure []+    Between n m p -> (:) <$> p <*> runFreq (Between (n - 1) (m - 1) p)++freqMatchesEpsilon :: Freq f a -> Maybe a+freqMatchesEpsilon freq =+  case freq of+    Opt  _         -> Just Nothing+    AtLeast 0 _    -> Just []+    Between 0 _ _  -> Just []+    _              -> Nothing++effectsMatchEpsilon :: Effects f a -> Maybe a+effectsMatchEpsilon eff =+  case eff of+    Nil x -> Just x+    freq :- ps -> freqMatchesEpsilon freq <**> effectsMatchEpsilon ps++-- | Splits a frequency such that the first effect in the result always occurs+-- exactly 'once'.+split :: Freq f a -> Effects f a+split freq =+  case freq of+    Once f        -> once f+    Opt  f        -> Just  <$> once f+    AtLeast n f   -> (:)   <$> once f <*> atLeast (0 `max` (n - 1)) f+    Between _ 1 f -> (:[]) <$> once f+    Between n m f -> (:)   <$> once f <*> between (0 `max` (n - 1)) (m - 1) f++lift :: Freq f a -> Effects f a+lift freq = freq :- Nil id++-- | Run the computation exactly once in each permutation.+once :: f a -> Effects f a+once = lift . Once++-- | Run the computation exactly zero or one times in each permutation.+opt :: f a -> Effects f (Maybe a)+opt = lift . Opt++-- | Run the computation at least so many times in each permutation.+atLeast :: Int -> f a -> Effects f [a]+atLeast n = lift . AtLeast n++-- | Run the computation between so and so many times (inclusive) in each+-- permutation.+between :: Int -> Int -> f a -> Effects f [a]+between n m = lift . Between n m++-- | Run the computation exactly so many times in each permutation.+exactly :: Int -> f a -> Effects f [a]+exactly n = between n n++-- | Run the computation zero or more times in each permutation.+many :: f a -> Effects f [a]+many = atLeast 0++-- | Run the computation one or more times in each permutation.+some :: f a -> Effects f [a]+some = atLeast 1++-- | Run the effects in order, respecting their frequencies.+runEffects :: Alternative f => Effects f a -> f a+runEffects (Nil x) = pure x+runEffects (freq :- ps) = runFreq freq <**> runEffects ps++-- | Build a tree (using '<|>' for branching) of all permutations of the+-- computations. The tree shape allows permutations to share common prefixes.+-- This allows clever computations to quickly prune away uninteresting+-- branches of permutations.+perms :: forall f a. Alternative f => Effects f a -> f a+perms (Nil x) = pure x+perms ps      = asum . eps . map (permTail . splitHead) . firsts $ ps+  where+    permTail :: Effects f a -> f a+    permTail (p :- ps') = runFreq p <**> perms ps'+    permTail _          = undefined++    eps :: [f a] -> [f a]+    eps =+      -- If none effects are required (i.e. all effects allow frequency 0), +      -- also allow the empty string.+      case effectsMatchEpsilon ps of+        Just x   -> (++ [pure x])+        Nothing  -> id++    splitHead :: Effects f a -> Effects f a+    splitHead (p :- ps') = split p <**> ps'+    splitHead _          = undefined++-- | Give each effect a chance to be the first effect in the chain, producing+-- @n@ new chains where @n@ is the 'length' of the input chain. In each case+-- the relative order of the effects is preserved with exception of the effect+-- that was moved to the front.+firsts :: Effects f a -> [Effects f a]+firsts (Nil _) = []+firsts (freq :- ps) =+  (freq :- ps) : map (\ps' -> swap (freq :- ps')) (firsts ps)++-- | Swaps the first two elements of the list, if they exist.+swap :: Effects f a -> Effects f a+swap (p0 :- p1 :- ps) = p1 :- p0 :- fmap flip ps+swap ps = ps

@@ -0,0 +1,30 @@+Copyright (c)2011, Martijn van Steenbergen++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 the name of Martijn van Steenbergen nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND 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 COPYRIGHT+OWNER OR 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,58 @@+-- PermuteEffects.cabal auto-generated by cabal init. For additional+-- options, see+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.+-- The name of the package.+Name:                PermuteEffects++-- The package version. See the Haskell package versioning policy+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for+-- standards guiding when and how versions should be incremented.+Version:             0.1++-- A short (one-line) description of the package.+Synopsis:            Permutations of effectful computations++-- A longer description of the package.+-- Description:         ++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Martijn van Steenbergen++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          martijn@van.steenbergen.nl++-- A copyright notice.+-- Copyright:           ++Category:            Control++Build-type:          Simple++-- Extra files to be distributed with the package, such as examples or+-- a README.+-- Extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+Cabal-version:       >=1.2+++Library+  -- Modules exported by the library.+  Exposed-modules:     Control.Applicative.Permute+  +  -- Packages needed in order to build this package.+  Build-depends:       base >= 4.2 && < 4.3+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +  

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