EventSourcing-DataMigration-Types/types.hs at master · AFASResearch/EventSourcing-DataMigration-Types · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
module Types where

type EventType = String
type StreamType = String
type Name = String
type Value = String
type Source = String
type Timestamp = Integer

type Event = (EventType, Timestamp, [Attribute])
type Attribute = (Name, Value)
type Stream = (StreamType, Source, [Event])
type Store = [Stream]

updateStore :: ([Stream] -> [Stream]) -> Store -> Store
updateStore c s = c s

type CreateStreams = [Stream] -> [Stream]
type DeleteStreams = [Stream] -> [Stream]
type MergeStreams = [Stream] -> [Stream]
type SplitStreams = [Stream] -> [Stream]


updateStream :: UpdateStreamPredicate -> ([Event] -> [Event]) -> Stream -> Stream
updateStream p b s@(streamType, source, events) | p s       = (streamType, source, b events)
                                                | otherwise = s

type UpdateStreamPredicate = Stream -> Bool

type CreateEvents = [Event] -> [Event]
type DeleteEvents = [Event] -> [Event]
type MergeEvents = [Event] -> [Event]
type SplitEvents = [Event] -> [Event]

updateEventType :: (EventType -> EventType) -> Event -> Event
updateEventType b (eventType, timeStamp, attrs) = (b eventType, timeStamp, attrs)

updateEvent :: UpdateEventPredicate -> ([Attribute] -> [Attribute]) -> Event -> Event
updateEvent p b e@(eventType, timeStamp, attrs) | p e       = (eventType, timeStamp, b attrs)
                                                | otherwise = e

type UpdateEventPredicate = Event -> Bool

type CreateAttributes = [Attribute] -> [Attribute]
type DeleteAttributes = [Attribute] -> [Attribute]
type MergeAttributes = [Attribute] -> [Attribute]
type SplitAttributes = [Attribute] -> [Attribute]

type UpdateAttribute = Attribute -> Attribute

-- Wrap the UpdateAttribute so that the resulting partially-applied function mathces what updateEvent expects
wrapUpdateAttribute :: UpdateAttributePredicate -> UpdateAttribute -> [Attribute] -> [Attribute]
wrapUpdateAttribute p f = map f'
    where f' x | p x = f x | otherwise = x

type UpdateAttributePredicate = Attribute -> Bool

type MergeStreamsNonSet = [Stream] -> Stream
type SplitStreamsNonSet = Stream -> [Stream]

type MergeEventsNonSet = [Event] -> Event
type SplitEventsNonSet = Event -> [Event]

type MergeAttributesNonSet = [Attribute] -> Attribute
type SplitAttributesNonSet = Attribute -> [Attribute]