unfoldable (empty) → 0.0.0

raw patch · 5 files changed

+211/−0 lines, 5 filesdep +basedep +randomdep +transformerssetup-changed

Dependencies added: base, random, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
src/Data/Splittable.hs +74/−0
src/Data/Unfoldable.hs +78/−0
unfoldable.cabal +27/−0

+ LICENSE view

@@ -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.

+ Setup.hs view

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

+ src/Data/Splittable.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Data.Splittable (+    Splittable(..)+  +  , boundedEnum+  +  , Left(..)+  , Right(..)+  +  ) where ++import qualified System.Random as R+import Data.List (mapAccumR)++-- | Splittable datatypes are datatypes that can be used as seeds for unfolds.+class Splittable s where+  -- | @split n s@ splits the seed @s@ in @n@ seeds. +  split  :: Int -> s -> [s]+  -- | @choose fs s@ uses part of the seed @s@ to choose a function from the list @fs@,+  -- and passes the remainder to that function.+  choose :: [s -> x] -> s -> x+  -- | Convert the seed value to an @int@.+  getInt :: s -> Int++-- | If a datatype is bounded and enumerable, we can use 'getInt' to produce a value from a seed.+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)++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 view

@@ -0,0 +1,78 @@+module Data.Unfoldable (++    Unfoldable(..)++  -- ** Specific unfolds+  , unfold+  , leftMost+  , rightMost++  -- ** Helper functions+  , spread+  , to++  ) where+    +import Control.Applicative+import Control.Monad.Trans.State+import Data.Splittable++-- | Data structures that can be unfolded.+--+-- For example, given a data type+--+-- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)+--+-- a suitable instance would be+--+-- > instance Unfoldable Tree where+-- >   unfoldMap f = choose+-- >     [ spread $ pure Empty+-- >     , spread $ Leaf <$> to f+-- >     , spread $ Node <$> to (unfoldMap f) <*> to f <*> to (unfoldMap f)+-- >     ]+--+-- i.e. it follows closely the instance for 'Traversable', with the addition of 'choose', 'spread' and 'to'.+-- +-- The instance can be simplified to:+--+-- > instance Unfoldable Tree where+-- >   unfoldMap f = choose+-- >     [ const Empty+-- >     , Leaf . f+-- >     , spread $ Node <$> to (unfoldMap f) <*> to f <*> to (unfoldMap f)+-- >     ]+class Unfoldable f where+  -- | Given a function to generate an element from a seed, +  -- and an initial seed, generate a structure.+  unfoldMap :: Splittable s => (s -> a) -> s -> f a++unfold :: (Unfoldable f, Splittable s) => s -> f s+unfold = unfoldMap id++leftMost :: Unfoldable f => f ()+leftMost = unfoldMap (const ()) L++rightMost :: Unfoldable f => f ()+rightMost = unfoldMap (const ()) R++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))++instance Unfoldable [] where+  unfoldMap f = go+    where+      go = choose [const [], spread $ (:) <$> to f <*> to go]++instance Unfoldable Maybe where+  unfoldMap f = choose [const Nothing, Just . f]++instance (Bounded a, Enum a) => Unfoldable (Either a) where+  unfoldMap f = choose [Left . boundedEnum, Right . f]++instance (Bounded a, Enum a) => Unfoldable ((,) a) where+  unfoldMap f = spread $ (,) <$> to boundedEnum <*> to f+

+ unfoldable.cabal view

@@ -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.6++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