improvements from Alex code review

docs/how-to-create-a-machine.md

@@ -199,7 +199,7 @@ a │ ┌╌╌╌╌┐ [b] ┌╌╌╌╌┐ │ [c]
 
 where the outputs `bs :: [b]` of the first machine are is passed as inputs to the second machine, and processed all one by one.
 
-Notice that in fact everything works not only for lists, but for every foldable type.
+We used lists `[b]` here to denote multiple outputs, but we can in fact use any [`Foldable`](https://hackage.haskell.org/package/base/docs/Prelude.html#t:Foldable) type.
 
 ## `Basic`
 
@@ -244,7 +244,7 @@ We use a `Topology vertex` kind, and we construct types of that kind using the `
 
 To define a `Topology`, we first need to define the type of its vertices.
 
-This is usually done by defining an enumeration of the vertices, like
+A straightforward approach is to define an enumeration of vertices, like
 
 ```haskell
 data ExampleVertex

spec/CRM/Example/RiskManager/Projection.hs

@@ -25,11 +25,15 @@ data ReceivedData = ReceivedData
 
 instance Semigroup ReceivedData where
   (<>) :: ReceivedData -> ReceivedData -> ReceivedData
-  (<>) (ReceivedData ud1 ld1 cbd1) (ReceivedData ud2 ld2 cbd2) =
+  r1 <> r2 =
     ReceivedData
-      (getLast $ Last ud1 <> Last ud2)
-      (getLast $ Last ld1 <> Last ld2)
-      (getLast $ Last cbd1 <> Last cbd2)
+      { receivedUserData =
+          getLast $ Last (receivedUserData r1) <> Last (receivedUserData r2)
+      , receivedLoanDetails =
+          getLast $ Last (receivedLoanDetails r1) <> Last (receivedLoanDetails r2)
+      , receivedCreditBureauData =
+          getLast $ Last (receivedCreditBureauData r1) <> Last (receivedCreditBureauData r2)
+      }
 
 instance Monoid ReceivedData where
   mempty :: ReceivedData

spec/CRM/RiskManagerSpec.hs

@@ -40,8 +40,9 @@ otherLoanDetails =
 creditBureauData :: CreditBureauData
 creditBureauData =
   CreditBureauData
-    (MissedPaymentDeadlines 2)
-    (EuroCents 100000)
+    { missedPaymentDeadlines = MissedPaymentDeadlines 2
+    , arrears = EuroCents 100000
+    }
 
 spec :: Spec
 spec =

src/CRM/BaseMachine.hs

@@ -149,6 +149,8 @@ instance Functor m => Functor (ActionResult m topology state initialVertex) wher
   fmap f (ActionResult outputStatePair) =
     ActionResult $ first f <$> outputStatePair
 
+-- | Create an `ActionResult` without performing any side effect in the `m`
+-- context
 pureResult
   :: (Applicative m, AllowedTransition topology initialVertex finalVertex)
   => output
@@ -156,15 +158,20 @@ pureResult
   -> ActionResult m topology state initialVertex output
 pureResult output state = ActionResult . pure $ (output, state)
 
+-- | This is fairly similar to `sequenceA` from `Traversable` and in fact it
+-- does the same job, with the slight difference that `sequenceA` would return
+-- `f (ActionResult Identity topology state initialVertex output)`
 sequence
-  :: ActionResult Identity topology state initialVertex [output]
-  -> ActionResult [] topology state initialVertex output
+  :: Functor f
+  => ActionResult Identity topology state initialVertex (f output)
+  -> ActionResult f topology state initialVertex output
 sequence (ActionResult (Identity (outputs, state))) =
   ActionResult $ (,state) <$> outputs
 
 -- ** Stateless machines
 
--- | The `statelessBaseT` transforms its input to its output and never changes its state
+-- | `statelessBaseT` transforms its input to its output and never changes its
+-- state
 statelessBaseT :: Applicative m => (a -> m b) -> BaseMachineT m (TrivialTopology @()) a b
 statelessBaseT f =
   BaseMachineT
@@ -173,6 +180,8 @@ statelessBaseT f =
         ActionResult $ (,state) <$> f input
     }
 
+-- | `statelessBase` transforms its input to its output and never changes its
+-- state, without performing any side effect
 statelessBase :: (a -> b) -> BaseMachine (TrivialTopology @()) a b
 statelessBase f = statelessBaseT (pure . f)
 

src/CRM/Graph.hs

@@ -31,17 +31,22 @@ transitiveClosureGraph graph@(Graph edges) =
   Graph $
     foldr
       ( \a edgesSoFar ->
-          edgesSoFar <> pathsStartingWith graph a
+          edgesSoFar <> pathsFrom graph a
       )
       []
       (nub $ fst <$> edges)
   where
-    pathsStartingWith :: Eq a => Graph a -> a -> [(a, a)]
-    pathsStartingWith graph'@(Graph edges') a =
+    edgesFrom :: Eq a => Graph a -> a -> [(a, a)]
+    edgesFrom (Graph edges') a = filter ((== a) . fst) edges'
+
+    pathsFrom :: forall a. Eq a => Graph a -> a -> [(a, a)]
+    pathsFrom g a =
       let
-        edgesStartingWithA = filter ((== a) . fst) edges'
+        edgesFromAToB = edgesFrom g a
+        pathsFromBToC = edgesFromAToB >>= pathsFrom g . snd
+        edgesFromAToC = (a,) . snd <$> pathsFromBToC
        in
-        edgesStartingWithA <> ((a,) . snd <$> (pathsStartingWith graph' . snd =<< edgesStartingWithA))
+        edgesFromAToB <> edgesFromAToC
 
 -- * UntypedGraph