separated-0.0.5: A data type with elements separated by values

Safe HaskellNone

Data.Separated

Contents

Synopsis

Data types

data Separated s a Source

A data type representing a list of pairs of separator and element values.

Instances

SeparatedCons Separated1 Separated 
SeparatedCons Separated Separated1 
Functor (Separated s)

Map across a Separated on the element values.

fmap id (x :: Separated Int String) == x
fmap (+1) (a +: b +: empty) == a +: (1+b) +: empty
Monoid s => Applicative (Separated s)

Applies functions with element values, using a zipping operation, appending separators. The identity operation is an infinite list of the empty separator and the given element value.

>>> (empty :: Separated [Int] (String -> [String])) <*> empty
[]
>>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <*> [3,4,5] +: "abc" +: empty
[[1,2,3,4,5],["abc","cba","bc"]]
Semigroup s => Apply (Separated s)

Applies functions with element values, using a zipping operation, appending separators.

>>> (empty :: Separated [Int] (String -> [String])) <.> empty
[]
>>> [1,2] +: (\s -> [s, reverse s, drop 1 s]) +: empty <.> [3,4,5] +: "abc" +: empty
[[1,2,3,4,5],["abc","cba","bc"]]
(Eq s, Eq a) => Eq (Separated s a) 
(Ord s, Ord a) => Ord (Separated s a) 
(Show s, Show a) => Show (Separated s a) 

data Separated1 a s Source

A data type representing element values interspersed with a separator.

There is one fewer separator values (s) than there are element values (a). There is at least one element value.

Instances

SeparatedCons Separated1 Separated 
SeparatedCons Separated Separated1 
Functor (Separated1 a)

Map across a Separated1 on the separator values.

>>> fmap (+1) (set separated1Tail (1 +: 'b' +: 2 +: 'c' +: empty) (single 'a'))
['a',2,'b',3,'c']
fmap id (x :: Separated1 Int String) == x
fmap (+1) (single x) == single x
Monoid s => Applicative (Separated1 s)

Applies functions with element values, using a zipping operation, appending elements. The identity operation is an infinite list of the empty element and the given separator value.

>>> [1,2] +: reverse +: [3,4] +: empty <*> [5,6,7] +: "abc" +: [8] +: empty
[[1,2,5,6,7],"cba",[3,4,8]]
Semigroup a => Apply (Separated1 a)

Applies functions with separator values, using a zipping operation, appending elements.

>>> [1,2] +: reverse +: [3,4] +: empty <.> [5,6,7] +: "abc" +: [8] +: empty
[[1,2,5,6,7],"cba",[3,4,8]]
(Eq a, Eq s) => Eq (Separated1 a s) 
(Ord a, Ord s) => Ord (Separated1 a s) 
(Show a, Show s) => Show (Separated1 a s) 

Inserting elements

class (f ~ SeparatedConsF g, g ~ SeparatedConsG f) => SeparatedCons f g whereSource

Prepend a value to a separated-like structure.

>>> 'z' +: empty
['z']
>>> 9 +: 'z' +: empty
[9,'z']

Associated Types

type SeparatedConsF g :: * -> * -> *Source

type SeparatedConsG f :: * -> * -> *Source

Methods

(+:) :: a -> f s a -> g a sSource

(++:) :: Separated1 s a -> Separated1 a s -> Separated s aSource

Append two lists of separated values to produce a list of pairs of separator and element values.

>>> single 7 ++: single 'a'
[7,'a']

a +: single 7 ++: single b [a,7,b]

a +: (b ++: c) == (a +: b) *+: c

(*+:) :: Separated s a -> Separated1 s a -> Separated1 s aSource

Append element values interspersed with a separator to a list of pairs of separator and element values.

>>> empty *+: single 7
[7]
>>> empty *+: 6 +: 'x' +: single 7
[6,'x',7]
>>> 'w' +: empty *+: 6 +: 'x' +: single 7
['w',6,'x',7]

(**:) :: Separated1 a s -> Separated s a -> Separated1 a sSource

Append a list of pairs of separator and element values to element values interspersed with a separator.

>>> single 7 **: empty
[7]
>>> single 6 **: 'x' +: 7 +: empty
[6,'x',7]
>>> 'w' +: single 6 **: 'x' +: 7 +: empty
['w',6,'x',7]

Constructing data types

empty :: Separated a sSource

An empty list of pairs of separator and element values.

>>> empty
[]
empty *+: x == x
x **: empty == x

single :: s -> Separated1 s aSource

Zero element values interspersed with one separator.

>>> single 4
[4]
single x ^. separated1Tail == empty

Extracting values from data types

allValues :: Separated' a -> [a]Source

Extract all values, where the separator and element are the same type.

>>> allValues empty
[]
>>> allValues (1 +: 2 +: 3 +: 4 +: empty)
[1,2,3,4]

allValues1 :: Separated1' a -> NonEmpty aSource

Extract all values, where the separator and element are the same type.

>>> allValues1 (single 7)
7 :| []
>>> allValues1 (1 +: 2 +: 3 +: empty)
1 :| [2,3]

separatedValues :: Separated a s -> [a]Source

Return all element values in a list of pairs of element and separator values.

separatedValues empty []

separatedValues (x +: 2 +: empty) [2]

separated1Values :: Separated1 a s -> NonEmpty aSource

Return all element values.

>>> separated1Values (single 8)
8 :| []
>>> separated1Values (7 +: 'a' +: single 8)
7 :| [8]
let h :| _ = separated1Values (single x) in h == (x :: Int)
let _ :| t = separated1Values (d +: e +: single x) in t == fmap fst [e]

separators :: Separated s a -> [s]Source

Return all separator values.

>>> separators empty
[]

separators (x +: 2 +: empty) [x]

separators1 :: Separated1 a s -> [s]Source

Return all separator values.

>>> separators ('a' +: single 7)
"a"
>>> separators ('a' +: 6 +:'b' +: single 7)
"ab"
separators (a +: single x) == [a]

Lenses and isomorphisms

separatedIso :: Iso' [(s, a)] (Separated s a)Source

The isomorphism to a list of pairs of element and separator values.

>>> separatedIso # empty
[]
>>> separatedIso # ('x' +: 6 +: empty)
[('x',6)]
>>> [] ^. separatedIso
[]
(6, [
)] ^. separatedIso [6,[]]

separatedSwap :: Iso' (Separated s a) (Separated a s)Source

The isomorphism that swaps elements with their separators.

>>> separatedSwap # empty
[]
>>> separatedSwap # ('x' +: 6 +: empty)
[6,'x']
>>> empty ^. separatedSwap
[]
>>> ('x' +: 6 +: empty) ^. separatedSwap
[6,'x']

separated1Iso :: Iso' (a, [(s, a)]) (Separated1 a s)Source

The isomorphism to element values interspersed with a separator.

>>> separated1Iso # (single 6)
(6,[])
>>> separated1Iso # (5 +: 'x' +: single 6)
(5,[('x',6)])
>>> (6, []) ^. separated1Iso
[6]
>>> (5, [('x', 6)]) ^. separated1Iso
[5,'x',6]

shift :: Iso' (Separated1 a s) ([(a, s)], a)Source

The isomorphism that shuffles the elements and separators one position.

>>> shift # ([], 6)
[6]
>>> shift # ([(5, 'x')], 6)
[5,'x',6]
>>> single 6 ^. shift
([],6)
>>> (5 +: 'x' +: single 6) ^. shift
([(5,'x')],6)

separated1Head :: Lens' (Separated1 a s) aSource

A lens on the first element value.

>>> single 7 ^. separated1Head
7
single x ^. separated1Head == (x :: Int)

separated1Tail :: Lens' (Separated1 a s) (Separated s a)Source

A lens on the tail.

d +: e +: single x ^. separated1Tail == e +: x +: empty

Alternating combinators

separatedWith :: Alternative f => f s -> f a -> f (Maybe (Separated1 s a))Source

Effectful separation with failure represented by Nothing.

>>> separatedWith Nothing Nothing
Just Nothing
>>> separatedWith Nothing (Just 7)
Just Nothing
>>> separatedWith (Just 'x') Nothing
Just (Just ['x'])
>>> separatedWith [] []
[Nothing]
>>> separatedWith [] [1,2,3]
[Nothing]
>>> separatedWith [1,2,3] []
[Just [1],Just [2],Just [3],Nothing]

separatedWith1 :: Alternative f => f a -> f s -> f (Separated1 a s)Source

Effectful separation.

>>> separatedWith1 Nothing Nothing
Nothing
>>> separatedWith1 Nothing (Just 7)
Nothing
>>> separatedWith1 (Just 'x') Nothing
Just ['x']
>>> separatedWith1 [] []
[]
>>> separatedWith1 [] [1,2,3]
[]
>>> separatedWith1 [1,2,3] []
[[1],[2],[3]]