rangedlist: The list like structure whose length or range of length can be specified
Please see the README on GitHub at https://github.com/YoshikuniJujo/rangedlist#readme
[Skip to Readme]
Downloads
 rangedlist0.1.2.1.tar.gz [browse] (Cabal source package)
 Package description (as included in the package)
Maintainer's Corner
For package maintainers and hackage trustees
Candidates
 No Candidates
Versions [RSS]  0.1.0.0, 0.1.0.1, 0.1.1.1, 0.1.2.0, 0.1.2.1 

Change log  ChangeLog.md 
Dependencies  base (>=4.7 && <5), typecheckpluginnatsimple (>=0.1.0.9) [details] 
License  BSD3Clause 
Copyright  Yoshikuni Jujo 
Author  Yoshikuni Jujo 
Maintainer  PAF01143@nifty.ne.jp 
Category  List 
Home page  https://github.com/YoshikuniJujo/rangedlist#readme 
Bug tracker  https://github.com/YoshikuniJujo/rangedlist/issues 
Source repo  head: git clone https://github.com/YoshikuniJujo/rangedlist 
Uploaded  by YoshikuniJujo at 20221227T03:17:37Z 
Distributions  LTSHaskell:0.1.2.1, NixOS:0.1.2.1, Stackage:0.1.2.1 
Downloads  632 total (16 in the last 30 days) 
Rating  (no votes yet) [estimated by Bayesian average] 
Your Rating 

Status  Docs not available [build log] All reported builds failed as of 20221227 [all 2 reports] 
Readme for rangedlist0.1.2.1
[back to package description]rangedlist
What's this
This package provides lists whose lengths are determined by the type and lists whose ranges of lengths are determined by the type.
sample1 :: LengthL 3 Integer
sample1 = 1 :. 2 :. 3 :. NilL
sample2 :: LengthR 3 Integer
sample2 = NilR :+ 1 :+ 2 :+ 3
sample3 :: RangeL 2 5 Integer
sample3 = 1 :. 2 :. 3 :.. 4 :.. NilL
sample4 :: RangeR 2 5 Integer
sample4 = NilR :++ 1 :++ 2 :+ 3 :+ 4
LengthL 3 Integer
and LengthR 3 Integer
are lists who have just 3 Integer
.
RangeL 2 5 Integer
and RangeR 2 5 Integer
are lists whose element numbers
are 2 at minimum and 5 at maximum.
LengthL 3 Integer
and RangeL 2 5 Integer
are
pushed or poped a element from left.
LengthR 3 Integer
and RangeR 2 5 Integer
are
pushed or poped a element from right.
Motivation
Suppose you want to take elements from list. You can use take
like following.
xs = take 3 "Hello, world!"
The length of xs
is lesser or equal 3
.
But you cannot use this knowledge when you write next code.
You should check the argument of a next function.
fun :: [Char] > ...
fun [] = ...
fun [x] = ...
fun [x, y] = ...
fun [x, y, z] = ...
fun _ = error "bad argument"
If you use LengthL 3 Char
,
you don't need to mind the argument has more than 3 elements.
fun :: LengthL 3 Char > ...
fun (x :. y :. z :. NilL) = ...
LengthL
To make rectangles from a number list
Suppose you want to make a value which represent a rectangle. You have a number list. The numbers are a left border, a top border, a width and a height of a rectangle in order. The numbers of the first rectangle are followed by the numbers of a second rectangle, and the numbers of the second rectangle are followed by the numbers of a third rectangle, and so on.
[left1, top1, width1, height1, left2, top2, width2, height2, left3, ...]
The list of numbers defined above are covert to a following list.
[Rect left1 top1 width1 height1, Rect left2 top2 width2 height2, Rect left3 ...]
The code is following. (View sample/rectangle.hs
)
import Data.Length.Length
data Rect = Rect {
left :: Double, top :: Double,
width :: Double, height :: Double } derivins Show
makeRect :: Length 4 Double > Rect
makeRect (l :. t :. w :. h :. NilL) = Rect l t w h
main :: IO ()
main = print $ map makeRect . fst $ chunksL [3, 5, 15, 2, 8, 4, 1, 9, 3, 5]
The function chunksL
return a value of type ([LengthL n a], RangeL 0 (n  1) a)
.
The first value of this tuple is a list of n
elements of type a
.
And the second value of this tuple is rest elements.
The number of the rest elements is 0
at minimum and n  1
at maximum.
Try running.
% stack ghc sample/rectangle.hs
% ./sample/rectangle
[Rect {left = 3.0, top = 5.0, width = 15.0, height = 2.0},
Rect {left = 8.0, top = 4.0, width = 1.0, height = 9.0)}
To take Word64 from bit list
Let's define function to take a 64 bit word from bit list. (View sample/word64.hs
)
The language extensions and the import list are following.
{# LANGUAGE LambdaCase #}
{# LANGUAGE MonoLocalBinds #}
{# LANGUAGE DAtaKinds, TypeOperators #}
{# LANGUAGE FlexibleContexts #}
{# OPTIONS_GHC Wall fnowarntabs #}
import GHC.TypeNats
import Data.Foldable
import Data.List.Length
import Data.List.Range
import Data.Bits
import Data.Word
import Numeric
You define function takeL
to take n
elements from list.
takeL :: (LoosenLMax 0 (n  1) n, Unfoldr 0 n n, ListToLengthL n) =>
a > [a] > LengthL n a
takeL d = either ((`fillL` d) . loosenLMax) fst . splitL
The function splitL
split a list and get n element lengthed list (LengthL n a
) and a rest of the list.
If the list does not contain enough elements, then it returns a left value. It is a list of type RangeL 0 (n  1) a
.
The function loosenLMax
convert the type RangeL 0 (n  1)
into RangeL 0 n
.
And the function fillL
fill the list with default value d
to get a list LengthL n a
.
Try it.
% stack ghci sample/word64.hs
> :set XDataKinds
> takeL '@' "Hello, world!" :: LengthL 5 Char
'H' :. ('e' :. ('l' :. ('l' :. ('o' :. NilL))))
> takeL 'W' "Hi!" :: LengthL 5 Char
'H' :. ('i' :. ('!' :. ('@' :. ('@' :. NilL))))
You define data type which represent a bit as follow.
data Bit = O  I deriving Show
boolToBit :: Bool > Bit
boolToBit = \case False > O; True > I
bitToNum63 :: (Num n, Bits n) => Bit > n
bitToNum63 = \case O > 0; I > 1 `shiftL` 63
O
is 0 and I
is 1.
Function boolToBit
converts a value of Bool
into a value of Bit
.
Function bitToNum63
converts a value of Bit
into a number.
It converte the bit as a 63rd bit.
You define the function which convert a bit list into 64 bit word.
bitsToWord64 :: LengthL 64 Bit > Word64
bitsToWord64 = foldl' (\w b > w `shiftR` 1 .. bitToNum63 b) 0
It gets a bit from the left end. It put the bit on a 63rd position of a 64 bit word. Then it gets a next bit. It shifts 64 bit word to the right. And it put the bit on a 63rd position of a 64 bit word. It continue in the same way.
You define the function which take 64 bit word from a bit list expressed as string.
takeWord64 :: String > Word64
takeWord64 = bitsToWord64 . takeL O . (boolToBit . (== '*') <$>)
The argument of this function is a string. The string represent a bit sequence. Character '*' is 1 and character '.' is 0.
You define sample string and try it in function main
.
sample1, sample2 :: String
sample1 = "...*..*..*...........*...**********...*************............******"
sample2 = "...*..*..*...........*.."
main :: IO ()
main = do
putStrLn $ takeWord64 sample1 `showHex` ""
putStrLn $ takeWord64 sample2 `showHex` ""
Try it.
% stack ghc sample/word64.hs
% ./sample/word64
8007ffc7fe200248
200248
LengthR
To push and pop from right
A value of the type LengthR n a
is a list of values of the type a
.
The length of the list is n
.
And you can push and pop an element from right.
Try it. (view sample/LengthR.hs
)
{# LANGUAGE DataKinds #}
{# OPTIONS_GHC Wall fnowarntabs #}
module LengthR where
import Data.List.Length
hello :: LengthR 5 Char
hello = NilR :+ 'h' :+ 'e' :+ 'l' :+ 'l' :+ 'o'
The value hello
is a list of characters which length is 5
.
Let's push the character '!'
from right.
% stack ghci sample/LengthR.hs
> hello
((((NilR :+ 'h') :+ 'e') :+ 'l') :+ 'l') :+ 'o'
> hello :+ '!'
(((((NilR :+ 'h') :+ 'e') :+ 'l') :+ 'l') :+ 'o') :+ '!'
To show 4 points of rectangles
function fourPoints
and headers
You want to calculate four points of rectangle
from the lefttop point, width and height of the rectangle.
You define function fourPoints
. (View sample/fourPointsOfRect.hs
)
fourPoints :: LengthR 4 Double > LengthR 4 (Double, Double)
fourPoints (NilR :+ l :+ t :+ w :+ h) =
NilR :+ (l, t) :+ (l + w, t) :+ (l, t + h) :+ (l + w, t + h)
You add language extensions and modules to import.
{# LANGUAGE BlockArguments, LambdaCase #}
{# LANGUAGE ScopedTypeVariables, TypeApplications #}
{# LANGUAGE DataKinds, TypeOperators #}
{# LANGUAGE GADTs #}
{# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,
UndecidableInstances #}
{# OPTIONS_GHC Wall fnowarntabs fplugin=Plugin.TypeCheck.Nat.Simple #}
import GHC.TypeNats
import Control.Monad.Fix
import Control.Monad.Catch
import Data.List.Length
import Text.Read
Try it.
% stack ghci sample/fourPointsOfRect.hs
> fourPoints $ NilR :+ 300 :+ 200 :+ 50 :+ 30
(((NilR :+ (300.0,200.0)) :+ (350.0,200.0)) :+ (300.0,230.0)) :+ (350.0,230.0)
to input values interactively
You want to input values of a left bound, a top bound, a width and a height
interactively.
You want to delete the last value and reinput a new value.
First of all, you define two data type,
DeleteOr a
and NothingToDeleteException
.
data DeleteOr a = Delete  Value a deriving Show
data NothingToDeleteException = NothingToDeleteException deriving Show
instance Exception NothingToDeleteException
And you define the function getElems
as a class function.
class GetElems n v where
getElems :: MonadThrow m =>
LengthR n a > m (Maybe (DeleteOr a)) > m (LengthR (n + v) a)
instance GetElems 0 0 where getElems NilR _ = pure NilR
instance {# OVERLAPPABLE #} 1 <= n => GetElems n 0 where
getElems xs@(_ :+ _) _ = pure xs
instance {# OVERLAPPABLE #} GetElems 1 (v  1) => GetElems 0 v where
getElems NilR gt = gt >>= \case
Nothing > getElems NilR gt
Just Delete > throwM NothingToDeleteException
Just (Value x) > getElem @1 @(v  1) (NilR :+ x) gt
instance {# OVERLAPPABLE #}
(1 <= n, GetElems (n  1) (v + 1), GetElems (n + 1) (v  1)) =>
GetElems n v where
getElems xa@(xs :+ _) gt = gt >>= \case
Nothing > getElems xa gt
Just Delete > getElems @(n  1) @(v + 1) xs gt
Just (Value x) > getElems @(n + 1) @(v  1) (xa :+ x) gt
class GetElems n v
The class function getElems
has two arguments.
The first argument is a list of values which are already inputed.
The second argument is a monad which returns 3 kinds of values,
a value which represents to delete, a new value to push to the list
or a value which represents to do nothing.
instance GetElems 0 0
n == 0
and v == 0
means that the function getElems
get
a list of no elements and return a list of no elements.
instance GetElems n 0
v == 0
means that the function getElems
get a list and
return the list as it is.
instance GetElems 0 v
n == 0
means that there are no already inputed elements.
The monad returns 3 kind of values.
If it returns Nothing
, then it rerun the whole as getElems NilR gt
.
If it returns Just Delete
, then NothingToDeleteException
occurs.
If it returns Just (Value x)
,
then it set the alreadyinputed elements to NilR :+ x
and rerun the whole.
instance GetElems n v
The monad gt
returns 3 kind of values.
If it returns Nothing
, then rerun the whole as getElems xa gt
.
If it returns Just Delete
,
then it remove an element from the alreadyinputed list
and rerun the whole.
If it returns Just (Value x)
,
then it set the alreadyinputed elements to xa :+ x
and rerun the whole.
to try it
Try it.
% stack ghci sample/fourPointsOfRect.hs
> :set XDataKinds XBlockArguments XLambdaCase
> getElems NilR (Just . Value <$> getLine) :: IO (LengthR 3 String)
foo
bar
baz
((NilR :+ "foo") :+ "bar") :+ "baz"
> gt = (<$> getLine) \case "" > Nothing; "d' > Just Delete; s > Just (Value s)
> getElems NilR gt :: IO (LengthR 3 String)
foo
bar
d
boo
baz
((NilR :+ "foo") :+ "boo") :+ "baz"
> getElems NilR gt :: IO (LengthR 3 String)
foo
bar
d
d
hoge
piyo
baz
((NilR :+ "hoge") :+ "piyo") :+ "baz"
> getElems NilR gt :: IO (LengthR 3 String)
foo
bar
d
d
d
*** Exception: NothingToDeleteException
function titles
You define the function titles
which show values as string with title.
titles :: (Show a, Applicative (LengthR n)) =>
Int > LengthR n String > LengthR n a > LengthR n String
titles n ts xs = (\t x > t ++ replicate (n  length t) ' ' ++ ": " ++ show x)
<$> ts <*> xs
Try it.
% stack ghci sample/fourPointsOfRect.hs
> titles 5 (NilR :+ "foo" :+ "bar" :+ "baz") (NilR :+ 123 :+ 456 :+ 789)
((NilR :+ "foo : 123") :+ "bar : 456") :+ "baz : 789"
function printResult
You define the function printResult
which show values expressing a rectangle
and 4 points of rectangle.
printResult :: LengthR 4 Double > IO ()
printResult r = do
putStrLn ""
putStrLn `mapM_` titles 6 t r; putStrLn ""
putStrLn `mapM_` titles 12 u (fourPoints r); putStrLn ""
where
t = NilR :+ "left :+ "top" :+ "width" :+ "height"
u = NIlR :+ "lefttop" :+ "righttop" :+ "leftbottom" :+ "rightbottom"
Try it.
% stack ghci sample/fourPointsOfRect.hs
> printResult $ NilR :+ 300 :+ 200 :+ 70 :+ 50
left : 300.0
top : 200.0
width : 70.0
height: 50.0
lefttop : (300.0,200.0)
righttop : (370.0,200.0)
leftbottom : (300.0,250.0)
rightbottom: (370.0,250.0)
function getRect
You define the function getRect
which gets user input to make rectangle.
getRect :: forall n . GetElems n (4  n) =>
LengthR n Double > IO (LengthR 4 Double)
getRect xs = (<$) <$> id <*> printRect =<<
getElems @n @(4  n) xs ((<$> getLine) \case
"d" > Just Delete; l > Value <*> readMaybe l)
`catch`
\(_ :: NothingToDeleteException) >
putStrLn *** Nothing to delete." >> getRect @0 NilR
It gets a user input with getLine
.
If it is "d"
, then it deletes the last input.
If there are nothing to delete, then NothingToDeleteException
occur.
It catches this exception and shows error message and rerun getRect
.
function main
You define function main
.
main :: IO ()
main = getRect NilR >>= fix \go xa@(xs :+ _) > getLine >>= \case
"q" > pure ()
"d" > go =<< getRect xs
_ > putStrLn "q or d" >> go xa
It call function getRect
with list of 0
elements (NilR
).
And it repeats function getRect
with list of 4  1
elements (xs
)
if you input "d"
.
% stack ghc sample/fourPointsOfRect.hs
% ./sample/fourPointsOfRect
500
300
75
50
left : 500.0
top : 300.0
width : 75.0
height: 50.0
lefttop : (500.0,300.0)
righttop : (575.0,300.0)
leftbottom : (500.0,350.0)
rightbottom: (575.0,350.0)
d
d
125
100
left : 500.0
top : 300.0
width : 125.0
height: 100.0
lefttop : (500.0,300.0)
righttop : (625.0,300.0)
leftbottom : (500.0,400.0)
rightbottom: (625.0,400.0)
d
d
d
d
d
*** Nothing to delete.
2000
1500
90
50
left : 2000.0
top : 1500.0
width : 90.0
height: 50.0
lefttop : (2000.0,1500.0)
righttop : (2090.0,1500.0)
leftbottom : (2000.0,1550.0)
rightbottom: (2090.0,1550.0)
q
RangeL and RangeR
To specify the range of a number of elements of a list
You can specify the range of a number of elements of a list.
There is a data type RangeL n m a
.
It represents a list which have a type a
element.
And its length is n
at minimum and m
at maximum.
% stack ghci
> :module Data.List.Range
> :set XDataKinds
> 'h' :. 'e' :. 'l' :. 'l' :.. 'o' :.. NilL :: RangeL 3 8 Char
'h' :. ('e' :. ('l' :. ('l' :.. ('o' :.. NilL))))
To get passwords
Suppose you want to get a password whose length is 8 at minimum and 127 at maximum. First of all, you define headers.
{# LANGUAGE OverloadedStrings #}
{# LANGUAGE DataKinds #}
{# LANGUAGE FlexibleContexts #}
{# OPTIONS_GHC Wall fnowarntabs #}
import Data.List.Range
import System.IO
import qualified Data.ByteString.Char8 as BSC
You define type Password
.
type Password = RangeL 8 127 Char
It is a list of Char
.
Its length is 8 at minimum and 127 at maximum.
You define a function getRangedString
.
It recieves a user input.
It return a just value if the length of the input is within range.
It return a nothing value if the length of the input is out of range.
getRangedPassword :: Unfoldr 0 n m => IO (Maybe (RangeL n m Char))
getRangedPassword = do
e < hGetEcho stdin
hSetEcho stdin False
unfoldrMRangeMaybe ((/= '\n') <$> hLookAhead stdin) getChar
<* hSetEcho stdin e
It makes echo of stdin off.
It gets characters until you input '\n'
.
And it makes echo of stdin on.
% stack ghci sample/password.hs
> :set XDataKinds
> getRangedPassword :: IO (Maybe Password)
(Input "foobarbaz")
Just ('f' :. ('o' :. ('o' :. ('b' :. ('a' :. ('r' :. ('b' :. ('a' :. ('z' :..NilL)))))))))
> getRangedPassword :: IO (Maybe Password)
(Input "foo")
Nothing
> getRangedPassword :: IO (Maybe (RangeL 2 5 Char))
(Input "foobar")
Nothing
> r
You want to convert a value of type Password
into a value of ByteString
.
You can use other packages if you get password as a value of ByteString
.
passwordToByteString :: Password > BSC.ByteString
passwordToByteString = foldr BSC.cons ""
You define function main
to try it.
main :: IO ()
main = do
p < getRangedPassword
print p
maybe (eror "bad password length") BSC.putStrLn $ passwordToByteString <$> p
Try it.
% stack ghc sample/password.hs
% ./sample/password
(Input "foobarbaz")
Just ('f' :. ('o' :. ('o' :. ('b' :. ('a' :. ('r' :. ('b' :. ('a' :. ('z' :.. NilL)))))))))
foobarbaz
Finger Tree
The next example is Finger Tree.
Finger Trees: A Simple Generalpurpose Data Structure
Language Extension and Import List
Let's make headers.
{# LANGUAGE ScopedTypeVariables, TypeApplications, InstanceSigs #}
{# LANGUAGE DataKinds, TypeOperators #}You
{# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances,
UndecidableInstances #}
{# OPTIONS_GHC Wall fnowarntabs fplugin=Plugin.TypeCheck.Nat.Simple #}
import GHC.TypeNats
import Data.List.Range
Types
You can describe Finger Tree as follows.
data FingerTree a
= Enpty  Single a
 Deep (DigitL a) (FingerTree (Node a)) (DigitR a)
deriving Show
type Node = RangeL 2 3
type DigitL = RangeL 1 4
type DigitR = RangeR 1 4
A list of type Node a
contains two or three elements of type a
.
A list of type DigitL a
contains one elements at minimum and
four elements at maximum.
A list of type DigitR a
contains the same number of elements as DigitL a
.
But you can push and pop a element from right.
To push from left
You define the function which Add a new element to the left of the sequence.
First of all you define the function to push an element to a list of type DigitL a
.
infixr 5 <
(<) :: a > DigitL a > Either (DigitL a) (DigitL a, Node a)
a < b :. NilL = Left $ a :. b :.. NilL
a < b :. c :.. NilL = Left $ a :. b :.. c :.. NilL
a < b :. c :.. d :.. NilL = Left $ a :. b :.. c :.. d :.. NilL
a < b :. c :.. d :.. e :.. NilL =
Right (a :. b :.. NilL, c :. d :. e :.. NilL)
If the original list has fewer elements than four,
then it return a left value list which contains the added value.
If the original list has just four elements,
then it returns a right value tuple which contain the value of type DigitL a
and the value of type Node a
.
You can define the function which add a new element to the left of the sequence.
infixr 5 <
(<) :: a > FingerTree a > FingerTree a
a < Empty = Single a
a < Single a = Deep (a :. NilL) Empty (NilR :+ b)
a < Deep pr m sf = case a < pr of
Left pr' > Deep pr' m sf
Right (pr', n3) > Deep pr' (n3 < m) sf
It pushes three of the elements as a Node
, leaving two behind.
You also require the liftings of <
.
infixr 5 <.
(<.) :: Foldable t => t a > FingerTree a > FingerTree a
(<.) = flip $ foldr (<)
To make finger tree from a list or other foldable structure,
you define a function toTree
.
toTree :: Foldable t => t a > FingerTree a
toTree = (<. Empty)
To push from right
Adding to the right end of the sequence is the mirror image of the above.
infixl 5 >, >, >.
(>) :: DigitR a > a > Either (DigitR a) (Node a, DigitR a)
NilR :+ a > b = Left $ NilR :++ a :+ b
NilR :++ a :+ b > c = Left $ NilR :++ a :++ b :+ c
NIlR :++ a :++ b :+ c > d = Left $ NilR :++ a :++ b :++ c :+ d
NilR :++ a :++ b :++ c :+ d > e =
Right (a :. b :. c :.. NilL, NilR :++ d :+ e)
(>) :: FingerTree a > a > FingerTree a
Empty > a = Single a
Single a > b = Deep (a :. NilL) Empty (NilR :+ b)
Deep pr m sf > a = case sf > a of
Left sf' > Deep pr m sf'
Right (n3, sf') > Deep pr (m > n3) sf'
(>.) :: Foldable t => FingerTree a > t a > FingerTree a
(>.) = foldl (>)
To pop from left
To deconstruct a sequence, you define a function uncons
.
uncons :: FingerTree a > Maybe (a, FingerTree a)
uncons Empty = Nothing
uncons (Single x) = Just (x, Empty)
uncons (Deep (a :. pr') m sf) = Just (a, deepL pr' m sf)
deepL :: RangeL 0 3 a > FingerTree (Node a) > DigitR a > FingerTree a
deepL NilL m sf = case uncons m of
Nothing > toTree sf
Just (n, m') > Deep (loosenL n) m' sf
deepL (a :.. pr) m sf = Deep (loosenL $ a :. pr) m sf
Since the prefix pr
of a Deep
tree contains at least one element,
you can get its head.
However, the tail of the prefix may be empty,
and thus unsuitable as a first argument to the Deep constructor.
Hence you define a smart constructor that differs from Deep
by allowing the
prefix to contain zero to three elements,
and in the empty case uses a uncons
of the middle tree to construct a tree of
the correct shape.
Concatenation
First of all you define a function which devide a list into a list of Node
.
The original list has 3 elements at minimum and 12 elements at maximum.
The returned list has 1 node at minimum and 4 nodes at maximum.
The function has a type like the following.
fun :: RangeL 3 12 a > RangeL 1 4 (Node a)
You can define a more general function like the following.
fun :: RangeL 3 m a > RangeL 1 w (Node a)
m
is 3 times w
.
You define a class.
class Nodes m w where nodes :: RangeL 3 m a > RangeL 1 w (Node a)
And you define instance when m
is 3 and w
is 1.
instance Nodes 3 1 where nodes = (:. NilL) . loosenL
And you define instance of general case.
instance {# OVERLAPPABLE #} (2 <= w, Nodes (m  3) (w  1)) => Nodes m w where
nodes :: forall a . RangeL 3 m a > RangeL 1 w (Node a)
nodes (a :. b :. c :. NilL) = (a :. b :. c :.. NilL) :. NilL
nodes (a :. b :. c :. d :.. NilL) =
(a :. b :. NilL) :. (c :. d :. NilL) :.. NilL
nodes (a :. b :. c :. d :.. e :.. NilL) =
(a :. b :. c :.. NilL) :. (d :. e :. NilL) :.. NilL
nodes (a :. b :. c :. d :.. e :.. f :.. xs) =
(a :. b :. c :.. NilL) .:..
nodes @(m  3) @(w  1) (d :. e :. f :. xs)
Try it.
% stack ghci sample/fingertree.hs
> :set XTypeApplications XDataKinds
> xs = 1 :. 2 :. 3 :. 4 :.. 5 :.. 6 :.. 7 :.. 8 :.. NilL :: RangeL 3 12 Integer
> nodes @12 @4 xs
(1 :. (2 :. (3 :.. NilL))) :. ((4 :. (5 :. (6 :.. NilL))) :.. ((7 :. (8 :. NilL)) :.. NilL))
> :type it
it :: Num a => RangeL 1 4 (Node a)
You can combine the two digit argument into a list of Nodes
with the function nodes
.
You can obtain a recursive function by
generalizing the concatenation function to take an additional list of elements.
app3 :: FingerTree a > RangeL 1 4 a > FingerTree a > FingerTree a
app3 Empty m xs = m <. xs
app3 xs m Empty = xs >. m
app3 (Single x) m xs = x < m <. xs
app3 xs m (Single x) = xs >. m > x
app3 (Deep pr1 m1 sf1) m (Deep pr2 m2 sf2) =
Deep pr1 (app3 m1 (nodes $ sf1 ++.. m ++. pr2) m2) sf2
To concatenate two finger trees, you take a head element from a second sequence.
(><) :: FingerTree a > FingerTree a > FingerTree a
l >< r = case uncons r of Nothing > l; Just (x, r') > app3 l (x :. NilL) r'