Skip to content

Instantly share code, notes, and snippets.

@amar47shah

amar47shah/JoinList.hs

Created October 25, 2015 19:33
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save amar47shah/afa4a4f6632f18b3ceb0 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save amar47shah/afa4a4f6632f18b3ceb0 to your computer and use it in GitHub Desktop.
Download ZIP
How to extract common form...?
Raw
JoinList.hs
module JoinList where
import Sized
import Data.Monoid ((<>))
data JoinList m a = Empty
| Single m a
| Append m (JoinList m a) (JoinList m a)
deriving (Eq, Show)
(+++) :: Monoid m => JoinList m a -> JoinList m a -> JoinList m a
j +++ k = Append (tag j <> tag k) j k
tag :: Monoid m => JoinList m a -> m
tag Empty = mempty
tag (Single t _) = t
tag (Append t _ _) = t
foldJ :: c -> (b -> a -> c) -> (b -> c -> c -> c) -> JoinList b a -> c
foldJ e _ _ Empty = e
foldJ _ s _ (Single t x) = s t x
foldJ e s a (Append t l r) = a t (foldJ e s a l) (foldJ e s a r)
indexJ :: (Sized b, Monoid b) => Int -> JoinList b a -> Maybe a
indexJ _ Empty = Nothing
indexJ i (Single _ x)
| i > 0 = Nothing
| i == 0 = Just x
| otherwise = Nothing
indexJ i (Append t l r)
| i >= wholeSize = Nothing
| i > leftSize = indexJ (i - leftSize) r
| i == leftSize = indexJ 0 r
| i > 0 = indexJ i l
| i == 0 = indexJ 0 l
| otherwise = Nothing
where wholeSize = getSize . size $ t
leftSize = getSize . size $ tag l
dropJ :: (Sized b, Monoid b) => Int -> JoinList b a -> JoinList b a
dropJ _ Empty = Empty
dropJ i jl@(Single _ _)
| i > 0 = Empty
| i == 0 = jl
| otherwise = jl
dropJ i jl@(Append t l r)
| i >= wholeSize = Empty
| i > leftSize = dropJ (i - leftSize) r
| i == leftSize = r
| i > 0 = dropJ i l +++ r
| i == 0 = jl
| otherwise = jl
where wholeSize = getSize . size $ t
leftSize = getSize . size $ tag l
takeJ :: (Sized b, Monoid b) => Int -> JoinList b a -> JoinList b a
takeJ _ Empty = Empty
takeJ i jl@(Single _ _)
| i > 0 = jl
| i == 0 = Empty
| otherwise = Empty
takeJ i jl@(Append t l r)
| i >= wholeSize = jl
| i > leftSize = l +++ takeJ (i - leftSize) r
| i == leftSize = l
| i > 0 = takeJ i l
| i == 0 = Empty
| otherwise = Empty
where wholeSize = getSize . size $ t
leftSize = getSize . size $ tag l
@amar47shah
Copy link
Author

amar47shah commented Nov 11, 2015

Half-brained attempt:

foldJ :: (Sized b, Monoid b) => c ->
         (a -> c) -> (a -> c) -> (a -> c) ->
         (Int -> JoinList b a -> c) ->
         (Int -> JoinList b a -> c) ->
         (Int -> JoinList b a -> c) ->
         (Int -> JoinList b a -> c) ->
         (Int -> JoinList b a -> c) ->
         (Int -> JoinList b a -> c) ->
         Int -> JoinList b a -> c
foldJ e _  _  _  _  _  _  _  _  _  _ Empty = e
foldJ _ sP s0 sN _  _  _  _  _  _  i (Single _ x)
 | i >  0    = sP x
 | i == 0    = s0 x
 | otherwise = sN x
foldJ _ _  _  _  a6 a5 a4 a3 a2 a1 i jl@(Append t l _)
   | i >= wholeSize = a6 i jl
   | i >  leftSize  = a5 i jl
   | i == leftSize  = a4 i jl
   | i >  0         = a3 i jl
   | i == 0         = a2 i jl
   | otherwise      = a1 i jl
  where wholeSize = getSize . size $ t
        leftSize  = getSize . size $ tag l

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment