Last active
September 1, 2016 13:10
-
-
Save dasch/1df9f07df532aa398accdd212ade1940 to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Aggregate exposing (..) | |
type alias Aggregate cmd error event state = | |
{ init : state | |
, apply : event -> state -> state | |
, handle : cmd -> state -> Result error event | |
} | |
type alias Coder cmd event = | |
{ decodeEvent : String -> Result String event | |
, decodeCmd : String -> Result String cmd | |
, encodeEvent : event -> String | |
} | |
hydrate : List event -> Aggregate cmd error event state -> state | |
hydrate events aggregate = | |
List.foldl aggregate.apply aggregate.init events |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module EventStore exposing (..) | |
import Time exposing (Time) | |
type alias Id = String | |
type alias Record e = | |
{ event : e | |
, timestamp : Time | |
} | |
type alias Log e = | |
{ id : Id | |
, version : Int | |
, events : List (Record e) | |
} | |
fetch : Id -> Log e | |
append : Id -> Record e -> Task Never () |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Projection exposing (Projection) | |
type alias Projection event state = | |
{ subscriptions : List (Subscription event) | |
, init : state | |
, apply : (String, event) -> state -> state | |
} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module TicketCountProjection exposing (projection) | |
import Ticketing | |
import Projection exposing (Projection) | |
type alias Event = Ticketing.Event | |
projection : Projection Event Int | |
projection = | |
{ init = init | |
, apply = apply | |
, subscriptions = subscription | |
} | |
init = 0 | |
apply (id, event) count = | |
case event of | |
TicketOpened _ -> | |
count + 1 | |
TicketClosed -> | |
count - 1 | |
subscriptions = | |
[ Ticketing.events ] |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Ticketing exposing (aggregate, Cmd(..), Event(..)) | |
import Aggregate exposing (Aggregate) | |
type Cmd | |
= OpenTicket { content : String } | |
| CloseTicket | |
| AssignTicket { assignee : String } | |
| UnassignTicket | |
type alias Error = String | |
type alias State = | |
{ content : String | |
, hasBeenOpened : Bool | |
, hasBeenClosed : Bool | |
, assignee : Maybe String | |
} | |
type Event | |
= TicketOpened { content : String } | |
| TicketClosed | |
| TicketAssigned { assignee : String } | |
| TicketUnassigned | |
init : State | |
init = | |
{ hasBeenOpened = False | |
, hasBeenClosed = False | |
, content = "N/A" | |
, assignee = Nothing | |
} | |
apply : Event -> State -> State | |
apply event state = | |
case event of | |
TicketOpened { content } -> | |
{ state | content = content } | |
TicketClosed -> | |
{ state | isOpen = false } | |
TicketAssigned { assignee } -> | |
{ state | assignee = Just assignee } | |
TicketUnassigned -> | |
{ state | assignee = Nothing } | |
handle : Cmd -> State -> Result Error Event | |
handle cmd state = | |
case cmd of | |
OpenTicket { content } -> | |
if state.hasBeenOpened then | |
Err "ticket already open" | |
else | |
Ok (TicketOpened content) | |
CloseTicket -> | |
if state.hasBeenClosed then | |
Err "ticket is already closed" | |
else if not state.hasBeenOpened | |
Err "ticket not open" | |
else | |
Ok TicketClosed | |
AssignTicket { assignee } -> | |
if state.hasBeenClosed then | |
Err "ticket closed" | |
else if not state.hasBeenOpened | |
Err "ticket not open" | |
else | |
Ok (TicketAssigned assignee) | |
UnassignTicket -> | |
Ok TicketUnassigned | |
aggregate : Aggregate Cmd Error Event State | |
aggregate = | |
{ init = init | |
, apply = apply | |
, handle = handle | |
} |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module TicketListProjection exposing (..) | |
import Projection exposing (Projection) | |
type Event | |
= TicketEvent Ticketing.Event | |
| UserEvent Users.Event | |
type alias State = | |
{ tickets : Dict String Ticket } | |
type alias Ticket = | |
{ id : String | |
, title : String | |
, authorId : String | |
, authorName : Maybe String | |
} | |
projection : Projection Event State | |
projection = | |
{ init = init | |
, apply = apply | |
, subscriptions = subscriptions | |
} | |
subscriptions = | |
[ Ticketing.events |> Subscription.map TicketEvent | |
, Users.events |> Subscription.map UserEvent | |
] | |
init = | |
{ tickets = Dict.empty } | |
apply : (String, Event) -> State -> State | |
apply (id, event) state = | |
case event of | |
TicketEvent event' -> | |
applyTicketEvent (id, event') state | |
UserEvent event' -> | |
applyUserEvent (id, event') state | |
applyTicketEvent (id, event) state = | |
case event of | |
TicketOpened { title, authorId } -> | |
let | |
ticket = { id = id, title = title, authorId = authorId, authorName = Nothing } | |
tickets = Dict.insert id ticket model.tickets | |
in | |
{ model | tickets = tickets } | |
TicketClosed -> | |
{ model | tickets = Dict.remove id model.tickets } | |
applyUserEvent (id, event) state = | |
case event of | |
UserAdded { name } -> | |
let | |
updateAuthor ticket = | |
if ticket.authorId == id then | |
{ ticket | authorName = Just name } | |
else | |
ticket | |
in | |
{ model | tickets = Dict.map updateAuthor model.tickets } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment