Initial commit.

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c)2012, Sjoerd Visscher
+
+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 Sjoerd Visscher 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.

README

@@ -0,0 +1 @@
+Class of data structures that can be unfolded from a seed value.

Setup.hs

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

src/Data/Splittable.hs

@@ -0,0 +1,59 @@
+module Data.Splittable (
+    Splittable(..)
+
+  , Left(..)
+  , Right(..)
+
+  ) where 
+
+import qualified System.Random as R
+import Data.List (mapAccumR)
+
+class Splittable s where
+  split  :: Int -> s -> [s]
+  choose :: [s -> x] -> s -> x
+  getInt :: s -> Int
+
+data Left = L
+instance Splittable Left where
+  split = replicate
+  choose fs = head fs
+  getInt L = 0
+
+data Right = R
+instance Splittable Right where
+  split = replicate
+  choose fs = last fs
+  getInt R = maxBound
+
+instance Splittable R.StdGen where
+  split 0 _ = []
+  split 1 s = [s]
+  split n s = let (s1, s2) = R.split s in s1 : split (n - 1) s2 
+  choose fs s = let (n, s') = R.next s in fs !! (n `mod` length fs) $ s'
+  getInt = fst . R.next
+
+instance Splittable Integer where
+  split n t = split' 1 (t, replicate n 0)
+    where
+      split' _ (0, l) = l
+      split' p (s, l) = split' (p * 2) $ mapAccumR (\s' i -> let (s'', b) = s' `divMod` 2 in (s'', i + b * p)) s l
+  choose fs s = let (s', n) = s `divMod` toInteger (length fs) in fs !! fromInteger n $ s'
+  getInt = fromInteger
+
+instance (Splittable a, Splittable b) => Splittable (a, b) where
+  split n (a, b) = zip (split n a) (split n b)
+  choose = uncurry . choose . map curry
+  getInt (a, b) = go (getInt a) (getInt b)
+    where
+      go 0 0 = 0
+      go m n = go m' n' * 4 + mb * 2 + nb
+        where
+          (m', mb) = m `divMod` 2
+          (n', nb) = n `divMod` 2
+
+instance (Splittable a, Splittable b) => Splittable (Either a b) where
+  split n   = either (map Left . split n) (map Right . split n)
+  choose fs = either (choose (map (. Left) fs)) (choose (map (. Right) fs))
+  getInt (Left a) = getInt a * 2
+  getInt (Right a) = getInt a * 2 + 1

src/Data/Unfoldable.hs

@@ -0,0 +1,44 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Data.Unfoldable (
+
+    Unfoldable(..)
+
+  , spread
+  , to
+  , boundedEnum
+
+  ) where
+
+import Control.Applicative
+import Control.Monad.Trans.State
+import Data.Splittable
+
+class Unfoldable f where
+  unfold :: Splittable s => (s -> a) -> (s -> f a)
+
+spread :: Splittable s => State ([s], Int) a -> s -> a
+spread f s = let (a, (_, i)) = runState f (split i s, 0) in a
+
+to :: (s -> a) -> State ([s], Int) a
+to f = state $ \(ss, i) -> (f (head ss), (tail ss, i + 1))
+
+boundedEnum :: forall s a. (Splittable s, Bounded a, Enum a) => s -> a
+boundedEnum s = toEnum $ (getInt s `mod` (1 + ub - lb)) + lb
+  where 
+    lb = fromEnum (minBound :: a)
+    ub = fromEnum (maxBound :: a)
+
+instance Unfoldable [] where
+  unfold f = go
+    where
+      go = choose [const [], spread $ (:) <$> to f <*> to go]
+
+instance Unfoldable Maybe where
+  unfold f = choose [const Nothing, Just . f]
+
+instance (Bounded a, Enum a) => Unfoldable (Either a) where
+  unfold f = choose [Left . boundedEnum, Right . f]
+
+instance (Bounded a, Enum a) => Unfoldable ((,) a) where
+  unfold f = spread $ (,) <$> to boundedEnum <*> to f
+

unfoldable.cabal

@@ -0,0 +1,27 @@
+Name:                unfoldable
+Version:             0.0.0
+Synopsis:            Class of data structures that can be unfolded from a seed value.
+Homepage:            https://github.com/sjoerdvisscher/unfoldable
+License:             BSD3
+License-file:        LICENSE
+Author:              Sjoerd Visscher
+Maintainer:          sjoerd@w3future.com
+Category:            Generics
+Build-type:          Simple
+Cabal-version:       >=1.2
+
+Library
+  HS-Source-Dirs:  src
+
+  Exposed-modules:
+    Data.Splittable
+    Data.Unfoldable  
+
+  Build-depends:
+      base         >= 4   && < 5 
+    , transformers >= 0.2 && < 0.4
+    , random       >= 1.0 && < 1.1
+
+source-repository head
+  type:     git
+  location: git://github.com/sjoerdvisscher/unfoldable.git