packages feed

data-cycle (empty) → 0.1.0

raw patch · 4 files changed

+374/−0 lines, 4 filesdep +basedep +collections-apidep +collections-base-instancessetup-changed

Dependencies added: base, collections-api, collections-base-instances

Files

+ Data/Cycle.hs view
@@ -0,0 +1,280 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}++module Data.Cycle +  (Cycle+  , goLeft, goRight, goLR+  , getValue, leftValue, rightValue, nthValue+  , takeLR, dropLR+  , cycleToInfiniteList+  , zipCycle, zipCycleWith+  ) where++import Data.Functor+import Data.Collections+import Data.Collections.BaseInstances+import Data.Maybe (fromJust)+import Data.Monoid++import Control.Monad+import Control.Applicative++import Prelude hiding (null, foldl, foldr, take, reverse, head, tail, drop)+import qualified Prelude++data DList a = MkDList (DList a) a (DList a)++-- | A cyclic doubly linked list. +--   +--   To create a new Cycle, use +--   'Data.Collections.fromList', 'Data.Collections.fromFoldable' or any of+--   the insertion functions from 'Data.Collections.Unfoldable'. Elements+--   are inserted in front of the current position.+--+--   To get the length of the list, use 'Data.Collections.size'. +--   To extract all cycle elements, use 'Data.Collections.toList'. You can+--   also create an infinite list with 'cycleToInfiniteList'.+--+--   The functions 'Data.Collections.front' and 'Data.Collections.back' +--   fail with 'error' for empty cycles.+--+--   'Data.Collections.take', 'Data.Collections.drop' and+--   'Data.Collections.splitAt' fail with 'error' for empty cycles if their+--   first argument is not 0. They also accept negative values for working+--   backwards (see 'takeLR' and 'dropLR' for details).+--+--   In general, any function @f@ working on+--   @[a]@ can be adapted for @Cycle a@ by writing @fromList . f . toList@.+--+--   The 'Monad', 'Functor', 'Applicative', 'Alternative', 'Monoid' and+--   'Foldable' instances work+--   like the default instances for lists.+data Cycle a = MkCycle Int (DList a)++dGoLeft :: DList a -> DList a+dGoLeft (MkDList l _ _) = l++-- | Move focus to the element on the left of the current position.+goLeft :: Cycle a -> Cycle a+goLeft c = MkCycle (cycleLength c) (dGoLeft $ cycleDList c)++dGoRight :: DList a -> DList a+dGoRight (MkDList _ _ r) = r++-- | Move focus to the element on the right of the current position.+--   +--   > goLeft . goRight == id+goRight :: Cycle a -> Cycle a+goRight c = MkCycle (cycleLength c) (dGoRight $ cycleDList c)++-- | Move @abs n@ steps to the left (@n \< 0@) or right (@n > 0@) or don't move+--   at all (@n == 0@).+goLR :: Int -> Cycle a -> Cycle a+goLR n c = (iterate f c) !! idx+  where +    idx = if n >= 0 then n else negate n+    f = if n >= 0 then goRight else goLeft++dGetValue :: DList a -> a+dGetValue (MkDList _ v _) = v++-- | Get the value at the current position. 'error' if @null c@.+getValue :: Cycle a -> a+getValue c = if null c +  then error "getValue: empty cycle"+  else dGetValue $ cycleDList c++-- | Get value on the left. 'error' if @null c@.+leftValue :: Cycle a -> a+leftValue = getValue . goLeft++-- | Get value on the right. 'error' if @null c@.+rightValue :: Cycle a -> a+rightValue = getValue . goRight++-- | Get nth value to the left (@n \< 0@) or right (@n > 0@) or +--   the current value (@n == 0@). 'error' if @null c@.+--+--   > nthValue = flip (!)+nthValue :: Int -> Cycle a -> a+nthValue n c +  | n < 0 = nthValueLeft (negate n) c+  | otherwise = nthValueRight n c++nthValueLeft :: Int -> Cycle a -> a+nthValueLeft 0 c = getValue c+nthValueLeft n c+  | n > 0 = nthValueLeft (n-1) (goLeft c)+  | n < 0 = undefined++nthValueRight :: Int -> Cycle a -> a+nthValueRight 0 c = getValue c+nthValueRight n c+  | n > 0 = nthValueRight (n-1) (goRight c)+  | n < 0 = undefined++cycleLength :: Cycle a -> Int+cycleLength (MkCycle n _) = n++cycleDList :: Cycle a -> DList a+cycleDList (MkCycle _ d) = d++-- same as listDList, but remember size+-- this makes it possible to implement cycleToList and to guard+-- getValue against empty list+listCycle :: [a] -> Cycle a+listCycle xs = MkCycle (length xs) (listDList xs)++-- create a cyclic doubly linked list from a list+-- for explanation, see: http://www.haskell.org/haskellwiki/Tying_the_Knot+listDList :: [a] -> DList a+listDList [] = error "listDList: empty list"+listDList xs = +  let +    (firstDList, lastDList) = go lastDList xs firstDList+  in+    firstDList+  where+    go :: DList a -> [a] -> DList a -> (DList a, DList a)+    go leftDList [] rightDList = (rightDList, leftDList)+    go leftDList (x:xs) rightDList = +      let +        thisDList = MkDList leftDList x nextDList+        (nextDList, lastDList) = go thisDList xs rightDList+      in +        (thisDList, lastDList)++-- creates an infinite list from a DList+dToList :: DList a -> [a]+dToList (MkDList _ v r) = v : dToList r++-- creates a finite list of length (cycleLength c)+cycleToList :: Cycle a -> [a]+cycleToList c = Prelude.take (cycleLength c) (cycleToInfiniteList c)++-- | Convert to an infinite list starting with the current value+--   and moving to the right.+cycleToInfiniteList :: Cycle a -> [a]+cycleToInfiniteList c = dToList $ cycleDList c++dTakeRight :: Int -> DList a -> [a]+dTakeRight n c =+  if n < 0 then undefined else go n c+  where+    go 0 _ = []+    go n c = dGetValue c : go (n-1) (dGoRight c)++dTakeLeft :: Int -> DList a -> [a]+dTakeLeft n c = +  if n < 0 then undefined else go n c+  where+    go 0 _ = []+    go n c = dGetValue c : go (n-1) (dGoLeft c)+    +takeRight :: Int -> Cycle a -> [a]+takeRight n c = dTakeRight n (cycleDList c)++takeLeft :: Int -> Cycle a -> [a]+takeLeft n c = dTakeLeft n (cycleDList c)++-- | Take @abs n@ values starting at the current one and moving +--   to the right (@n > 0@) or left (@n \< 0@). @n@ can be arbitrary+--   big. +--+--   > take n = fromList . takeLR n+takeLR :: Int -> Cycle a -> [a]+takeLR n c+  | n < 0 = takeLeft (negate n) c+  | otherwise = takeRight n c+++-- | Drop @abs n@ values starting at the current one and moving +--   to the right (@n > 0@) or left (@n \< 0@). @n@ can be arbitrary+--   big.+--+--   > drop n = fromList . dropLR n+dropLR :: Int -> Cycle a -> [a]+dropLR n c+  | n < 0 = reverse $ dropLR (negate n) $ reverse c+  | otherwise = drop n $ toList c++instance Functor DList where+  fmap fn c = MkDList (fmap fn $ dGoLeft c) (fn $ dGetValue c) (fmap fn $ dGoRight c)++instance Functor Cycle where+  fmap fn c = MkCycle (cycleLength c) (fmap fn (cycleDList c))++instance Applicative Cycle where+  pure = singleton+  fs <*> xs = fromList (toList fs <*> toList xs)++instance Alternative Cycle where+  empty = Data.Collections.empty+  xs <|> ys = fromList (toList xs <|> toList ys)++instance Monad Cycle where+  return = pure+  xs >>= fn = fromList $ toList xs >>= (toList . fn) ++instance Unfoldable (Cycle a) a where+  -- inserts before current position+  insert x c = listCycle $ x : cycleToList c+  empty = listCycle []+  singleton x = listCycle [x]+  insertMany f c = foldr insert c f+  insertManySorted = insertMany++instance Foldable (Cycle a) a where+  foldr f z = foldr f z . cycleToList+  size = cycleLength+  null = (==0) . size+  isSingleton = (==1) . size++instance Collection (Cycle a) a where+  filter pred c = listCycle $ Prelude.filter pred $ cycleToList c++-- | Combine to cycles by applying a binary function to all element+--   pairs. Like 'Data.List.zipWith'.+zipCycleWith :: (a -> b -> c) -> Cycle a -> Cycle b -> Cycle c+zipCycleWith fn c1 c2 = fromList $ zipWith fn (toList c1) (toList c2)++-- | > zipCycle = zipCycleWith (,)+zipCycle :: Cycle a -> Cycle b -> Cycle (a, b)+zipCycle = zipCycleWith (,)++instance Show a => Show (Cycle a) where+  show c = "fromList " ++ show (toList c)++instance Monoid (Cycle a) where+  mempty = Data.Collections.empty+  xs `mappend` ys = insertMany xs ys++instance Sequence (Cycle a) a where+  take n = fromList . takeLR n+  drop n = fromList . dropLR n+  reverse = fromList . reverse . toList+  front c = if null c then Nothing else Just (getValue c, drop 1 c)+  back c = let s = size c in+      if s == 0+        then Nothing +        else Just (take (s-1) c, nthValue (s-1) c)+  cons = insert+  snoc c x = reverse $ insert x $ reverse c+  a `isPrefix` b = toList a `isPrefix` toList b+  splitAt n c = (take n c, drop n c)++instance Indexed (Cycle a) Int a where+  index k c = nthValue k c+  adjust f k c = +    let+      c' = goLR k c+      vs = toList c'+      xs = f (head vs) : tail vs+      c'' = fromList xs+    in+      goLR (-k) c''+  inDomain k c = not (null c)+  c // a = foldr (\(k,v) c' -> adjust (const v) k c') c a++instance Eq a => Eq (Cycle a) where+  xs == ys = toList xs == toList ys+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Tobias Brandt++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 Tobias Brandt 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
+ data-cycle.cabal view
@@ -0,0 +1,62 @@+-- data-cycle.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:                data-cycle++-- 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.0++-- A short (one-line) description of the package.+Synopsis:            a cyclic doubly linked list++-- A longer description of the package.+Description:         This package implements a cyclic doubly linked list and+                     defines various instances for it.++-- The license under which the package is released.+License:             BSD3++-- The file containing the license text.+License-file:        LICENSE++-- The package author(s).+Author:              Tobias Brandt++-- An email address to which users can send suggestions, bug reports,+-- and patches.+Maintainer:          tob.brandt@gmail.com++-- A copyright notice.+-- Copyright:           ++Category:            Data++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.6+++Library+  -- Modules exported by the library.+  Exposed-modules:     Data.Cycle+  +  -- Packages needed in order to build this package.+  Build-depends: +    base == 4.3.*, +    collections-api == 1.0.*, +    collections-base-instances == 1.0.*+  +  -- Modules not exported by this package.+  -- Other-modules:       +  +  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.+  -- Build-tools:         +