[Haskell-cafe] Capped lists and |append|

[Nicolas Pouillard]

Excerpts from John Millikin's message of Sat Jan 09 00:38:15 +0100 2010:
> Earlier today I uploaded the capped-list package; I didn't think there
> would be any interest, since it's a relatively trivial data structure,
> but already there's been three emails and an IRC convo about it.
> 
> In short, this is Heinrich Apfelmus's "Train" type from
> <http://www.haskell.org/pipermail/haskell-cafe/2009-December/069895.html>,
> which showed up in a thread I posted regarding lazy error handling
> <http://www.haskell.org/pipermail/haskell-cafe/2009-November/069825.html>.
> The structure of a Train / CappedList (I like my name better) is:
> 
>     data Train a b = Wagon a (Train a b) | Loco  b
>     data CappedList cap a = Next a (CappedList cap a) | Cap cap
> 
> Since uploading, there's been a big problem pointed out to me
> regarding this structure, namely the possible definitions of |append|.
> Because the list terminus is itself a value, but isn't / shouldn't be
> the same type as the elements, either obvious implementation will drop
> it.

I would suggest:

appendWith :: (cap1 -> cap2 -> cap3)
           -> CappedList cap1 a
           -> CappedList cap2 a
           -> CappedList cap3 a

Here is some functions I written when reading about this data-type:

data Train a b = Wagon a (Train a b)
               | Caboose b

trainToList :: (b -> [a]) -> Train a b -> [a]
trainToList f (Wagon x xs) = x : trainToList f xs
trainToList f (Caboose x)  = f x

addCaboose :: b -> [a] -> Train a b
addCaboose b []     = Caboose b
addCaboose b (x:xs) = Wagon x (addCaboose b xs)

caboose :: Train a b -> b
caboose (Wagon _ xs) = caboose xs
caboose (Caboose x)  = x

dropCaboose :: Train a b -> [a]
dropCaboose = trainToList (const [])

updateCaboose :: (b -> Train a c) -> Train a b -> Train a c
updateCaboose f (Wagon x xs) = Wagon x (updateCaboose f xs)
updateCaboose f (Caboose x)  = f x

-- change caboose's contents
mapCaboose :: (b -> c) -> Train a b -> Train a c
mapCaboose f = updateCaboose (Caboose . f)

-- append trains and merge cabooses
appendTrain :: (b -> c -> d) -> Train a b -> Train a c -> Train a d
appendTrain f xs ys = updateCaboose (\b -> updateCaboose (Caboose . f b) ys) xs

-- concat trains and merge cabooses
concatTrain :: (b -> c -> c) -> c -> [Train a b] -> Train a c
concatTrain f = foldr (appendTrain f) . Caboose

foldl'TrainWith :: (a -> c -> d) -> (a -> b -> a) -> a -> Train b c -> Train b d
foldl'TrainWith p f z (Wagon x xs) = z `seq` Wagon x (foldl'TrainWith p f (f z x) xs)
foldl'TrainWith p f z (Caboose x)  = Caboose (p z x)

foldl'Train :: (a -> b -> a) -> a -> Train b c -> Train b (a,c)
foldl'Train = foldl'TrainWith (,)

sumTrain :: Num n => Train n a -> Train n (n, a)
sumTrain = foldl'Train (+) 0

productTrain :: Num n => Train n a -> Train n (n, a)
productTrain = foldl'Train (*) 1

-- For instance to compute both the sum and the product of a train
-- modularly:
--
-- fst . caboose . sumTrain . productTrain :: Num n => Train n a -> (n , n)

concatAndSumCabooses :: Num b => [Train a b] -> Train a b
concatAndSumCabooses = concatTrain (+) 0


-- 
Nicolas Pouillard
http://nicolaspouillard.fr