PermuteEffects 0.1.1 → 0.2

raw patch · 4 files changed

+119/−176 lines, 4 filesdep +ReplicateEffectsPVP ok

version bump matches the API change (PVP)

Dependencies added: ReplicateEffects

API changes (from Hackage documentation)

Files

• Control/Applicative/Permute.hs +0/−164
• Control/Permute.hs +85/−0
• ParsecEx.hs +29/−8
• PermuteEffects.cabal +5/−4

@@ -1,164 +0,0 @@-{-# 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,85 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Control.Permute ( Effects, perms, (*.) ) where++import Prelude hiding (length, sequence)+import Control.Applicative hiding (some, many)+import Data.Foldable+import Control.Replicate hiding (Nil, Cons)+import qualified Control.Replicate as R++-- | A chain of effectful @f@-computations with composite result @a@.+-- Individual computations (lifted into @Effects@ using '*.' below) have their+-- own result types, which fit together in standard 'Applicative' fashion.+-- Although these result types are lost in the composite type, 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+  Cons :: f x -> Replicate x y -> Effects f (y -> z) -> Effects f z++-- | Map over the final result type.+instance Functor (Effects f) where+  fmap f (Nil x)       = Nil (f x)+  fmap f (Cons a r ps) = Cons a r (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+  Cons a r x <*> y = Cons a r (flip <$> x <*> y)++-- | Compute the length of a list of computations.+length :: Effects f a -> Int+length (Nil _)       = 0+length (Cons _ _ xs) = 1 + length xs++-- | Allow a computation to be occur so many times in each permutation.+(*.) :: Replicate a b -> f a -> Effects f b+freq *. act = Cons act freq (Nil id)++-- | If all the effects in the chain allow frequency 0, we can execute them+-- all 0 times and get a result.+effectsMatchEpsilon :: Effects f a -> Maybe a+effectsMatchEpsilon eff =+  case eff of+    Nil x                    -> Just x+    Cons  _ (R.Cons mz _) ps -> mz <**> effectsMatchEpsilon 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      = eps . asum . map split . firsts $ ps+  where+    split :: Effects f a -> f a+    split (Cons _ R.Nil _) = empty+    split (Cons _ (R.Cons (Just z) R.Nil) ps') = perms (($ z) <$> ps')+    split (Cons act (R.Cons _ s) ps') = act <**> perms (Cons act s ((.) <$> ps'))++    eps :: f a -> f a+    eps =+      -- If none effects are required (i.e. all effects allow frequency 0), +      -- also allow a pure action.+      case effectsMatchEpsilon ps of+        Just x   -> (<|> pure x)+        Nothing  -> id++-- | Through repeated 'swap'ping, 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 (Cons a r ps) =+  (Cons a r ps) : map (\ps' -> swap (Cons a r ps')) (firsts ps)++-- | Swaps the first two elements of the list, if they exist.+swap :: Effects f a -> Effects f a+swap (Cons a1 r1 (Cons a2 r2 ps)) = Cons a2 r2 (Cons a1 r1 (fmap flip ps))+swap ps = ps

@@ -1,17 +1,38 @@ module ParsecEx where -import Control.Applicative.Permute+import Control.Replicate+import Control.Permute +import Prelude hiding (id, (.))+import Control.Category+ import Data.Traversable import Control.Applicative hiding (some, many) -import Text.Parsec hiding (many, between)+import Text.Parsec hiding ((<|>), many, between) -alphabet :: [String]-alphabet = map pure ['a'..'z'] -hoogeveen :: [String]-hoogeveen = ["aap", "noot", "mies", "wim"]+-- | Expect exactly one of each of the 26 letters in the alphabet, in any+-- order, but return them rearranged in sorted order.+alphabet :: String -> Either ParseError String+alphabet = runParser (perms p <* eof) () ""+  where+    p = for ['a'..'z'] (\c -> one *. char c) -example :: [String] -> String -> Either ParseError [String]-example opts = runParser (perms (for opts (once . string)) <* eof) () ""+-- | Parse the input, collecting the 26 letters from the alphabet in 26+-- buckets.+buckets :: String -> Either ParseError [String]+buckets = runParser (perms p <* eof) () ""+  where+    p = for ['a'..'z'] (\c -> many *. char c)++-- The example from Monad Reader issue 17, page 15+-- http://themonadreader.wordpress.com/2011/01/09/issue-17/+-- A crucial difference is that in our case the individual parsers can have+-- different types.+exampleInterleaveT :: String -> Either ParseError (String, String, Char)+exampleInterleaveT = runParser (perms p <* eof) () ""+  where+    p = (,,) <$> many     *. char 'a'+             <*> atMost 6 *. char 'b'+             <*> one      *. char 'c'

@@ -1,5 +1,5 @@ Name:                PermuteEffects-Version:             0.1.1+Version:             0.2 Synopsis:            Permutations of effectful computations -- Description:          Category:            Control@@ -7,9 +7,10 @@ License:             BSD3 License-file:        LICENSE -Author:              Martijn van Steenbergen+Author:              Martijn van Steenbergen, Sjoerd Visscher Maintainer:          martijn@van.steenbergen.nl Homepage:            https://github.com/MedeaMelana/PermuteEffects+Bug-reports:         https://github.com/MedeaMelana/PermuteEffects/issues -- Copyright:             @@ -18,5 +19,5 @@ Cabal-version:       >= 1.2  Library-  Exposed-modules:     Control.Applicative.Permute-  Build-depends:       base >= 4.0 && < 4.4+  Exposed-modules:     Control.Permute+  Build-depends:       base >= 4.0 && < 4.4, ReplicateEffects >= 0.2 && < 0.3