Permalink
Browse files

Specialised branch to Control.Replicate only.

  • Loading branch information...
MedeaMelana committed Jan 14, 2011
1 parent aa924f6 commit 964628d29a1ca7afe8a507770d1c8aa3165c0009
Showing with 7 additions and 136 deletions.
  1. +0 −89 Control/Applicative/Permute.hs
  2. +2 −2 Makefile
  3. +0 −38 ParsecEx.hs
  4. +5 −7 PermuteEffects.cabal → ReplicateEffects.cabal
@@ -1,89 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Control.Applicative.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
-
-runEffects :: Alternative f => Effects f a -> f a
-runEffects (Nil x) = pure x
-runEffects (Cons act freq fs) = run freq act <**> runEffects fs
-
--- | 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
-
--- | 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
View
@@ -1,7 +1,7 @@
default: run
run:
- ghci -Wall ParsecEx
+ ghci -Wall Control.Replicate
configure:
cabal configure
@@ -10,4 +10,4 @@ docs: configure
cabal haddock
opendocs: docs
- open dist/doc/html/PermuteEffects/index.html
+ open dist/doc/html/ReplicateEffects/index.html
View
@@ -1,38 +0,0 @@
-module ParsecEx where
-
-import Control.Replicate
-import Control.Applicative.Permute
-
-import Prelude hiding (id, (.))
-import Control.Category
-
-import Data.Traversable
-import Control.Applicative hiding (some, many)
-
-import Text.Parsec hiding ((<|>), many, between)
-
-
--- | 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)
-
--- | 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], String)
-exampleInterleaveT = runParser (perms p <* eof) () ""
- where
- p = (,,) <$> many *. string "a"
- <*> atMost 6 *. string "b"
- <*> one *. string "c"
@@ -1,6 +1,6 @@
-Name: PermuteEffects
-Version: 0.1.1
-Synopsis: Permutations of effectful computations
+Name: ReplicateEffects
+Version: 0.2
+Synopsis: Composable replication schemes of applicative functors
-- Description:
Category: Control
@@ -9,16 +9,14 @@ License-file: LICENSE
Author: Martijn van Steenbergen
Maintainer: martijn@van.steenbergen.nl
-Homepage: https://github.com/MedeaMelana/PermuteEffects
-Bug-reports: https://github.com/MedeaMelana/PermuteEffects/issues
+Homepage: https://github.com/MedeaMelana/ReplicateEffects
+Bug-reports: https://github.com/MedeaMelana/ReplicateEffects/issues
-- Copyright:
Build-type: Simple
-Extra-source-files: ParsecEx.hs
Cabal-version: >= 1.2
Library
Exposed-modules: Control.Replicate
- Control.Applicative.Permute
Build-depends: base >= 4.0 && < 4.4

0 comments on commit 964628d

Please sign in to comment.