fix: Critical global position bug + Complete backward reading test coverage

cli/src/Neo/Build.hs

@@ -15,7 +15,6 @@ import Path qualified
 import Subprocess qualified
 import Task qualified
 import Text qualified
-import ToText (toText)
 
 
 data Error

core/core/Array.hs

@@ -14,6 +14,8 @@ module Array (
   isEmpty,
   length,
   get,
+  maximum,
+  minimum,
 
   -- * Manipulate
   set,
@@ -52,9 +54,11 @@ module Array (
   zip,
   sumIntegers,
   reverse,
+  flatten,
 ) where
 
 import Basics
+import Control.Monad qualified
 import Data.Foldable qualified
 import Data.Vector ((!?), (++), (//))
 import Data.Vector qualified
@@ -416,3 +420,26 @@ sumIntegers (Array vector) = Data.Vector.sum vector
 -- | Reverse an array.
 reverse :: Array a -> Array a
 reverse (Array vector) = Array (Data.Vector.reverse vector)
+
+
+-- | Flatten an array of arrays into a single array.
+flatten :: Array (Array a) -> Array a
+flatten (Array vector) = Array (Control.Monad.join (Data.Vector.map unwrap vector))
+
+
+-- | Find the maximum element in an array.
+-- If the array is empty, returns `Nothing`.
+maximum :: forall (value :: Type). (Ord value) => Array value -> Maybe value
+maximum (Array vector) =
+  if Data.Vector.null vector
+    then Nothing
+    else Just (Data.Vector.maximum vector)
+
+
+-- | Find the minimum element in an array.
+-- If the array is empty, returns `Nothing`.
+minimum :: forall (value :: Type). (Ord value) => Array value -> Maybe value
+minimum (Array vector) =
+  if Data.Vector.null vector
+    then Nothing
+    else Just (Data.Vector.minimum vector)

core/core/Basics.hs

@@ -11,9 +11,9 @@ module Basics (
   -- * Math
   Int,
   Float,
-  Positive (..),
-  makePositive,
-  makePositiveOrPanic,
+  Natural (..),
+  makeNatural,
+  makeNaturalOrPanic,
   (+),
   (-),
   (*),
@@ -123,6 +123,7 @@ module Basics (
   Type,
   Control.Monad.forever,
   GHC.Generics.Generic,
+  GHC.Stack.HasCallStack,
 ) where
 
 import Applicable (Applicable)
@@ -238,27 +239,27 @@ type Int = Prelude.Int
 type Float = Prelude.Double
 
 
--- | A @Positive@ number is a number that is greater than zero. It is used to
+-- | A @Natural@ number is a number that is greater than zero. It is used to
 -- represent things like the length of a list or the number of items in a
 -- collection. It is a wrapper around @a@. But the constructor is not exported,
--- so you cannot create a @Positive@ number directly, except by using the constructor
-newtype Positive a = Positive a
+-- so you cannot create a @Natural@ number directly, except by using the constructor
+newtype Natural a = Natural a
   deriving
     (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Read, Prelude.Num, Prelude.Real, Prelude.Enum, Prelude.Integral)
 
 
--- | Create a Positive number from a regular number.
+-- | Create a Natural number from a regular number.
 -- Returns Nothing if the input is not positive ( > 0).
-makePositive :: (Prelude.Ord number, Prelude.Num number) => number -> Prelude.Maybe (Positive number)
-makePositive number = if number > 0 then Prelude.Just (Positive number) else Prelude.Nothing
+makeNatural :: (Prelude.Ord number, Prelude.Num number) => number -> Prelude.Maybe (Natural number)
+makeNatural number = if number > 0 then Prelude.Just (Natural number) else Prelude.Nothing
 
 
--- | Create a Positive number from a regular number.
+-- | Create a Natural number from a regular number.
 -- Panics if the input is not positive.
-makePositiveOrPanic :: (Prelude.Ord number, Prelude.Num number, Prelude.Show number) => number -> Positive number
-makePositiveOrPanic number =
+makeNaturalOrPanic :: (Prelude.Ord number, Prelude.Num number, Prelude.Show number) => number -> Natural number
+makeNaturalOrPanic number =
   if number > 0
-    then Positive number
+    then Natural number
     else panic ("Expected a positive number, but got: " Prelude.<> Text.pack (Prelude.show number))
 
 

core/core/Core.hs

@@ -26,7 +26,7 @@ import Result as Reexported (Result (..))
 -- import Service.Core as Reexported (View)
 import Task as Reexported (Task)
 import Text as Reexported (Text)
-import ToText as Reexported (Show, ToText, toPrettyText)
+import ToText as Reexported (Show, ToText, toPrettyText, toText)
 import Trigger as Reexported (Trigger)
 import Unknown as Reexported (Unknown)
 import Uuid as Reexported (Uuid)

core/core/Task.hs

@@ -56,41 +56,49 @@ newtype Task err value = Task
 
 yield :: value -> Task _ value
 yield value = Task (Applicable.pure value)
+{-# INLINE yield #-}
 
 
 throw :: err -> Task err _
 throw err = Task (Except.throwE err)
+{-# INLINE throw #-}
 
 
 map :: (input -> output) -> Task err input -> Task err output
 map f self = Task (Mappable.map f (runTask self))
+{-# INLINE map #-}
 
 
 mapError :: (err1 -> err2) -> Task err1 value -> Task err2 value
 mapError f self =
   runTask self
     |> Except.withExceptT f
     |> Task
+{-# INLINE mapError #-}
 
 
 apply :: Task err (input -> output) -> Task err input -> Task err output
 apply taskFunction self = Task (Applicable.apply (runTask taskFunction) (runTask self))
+{-# INLINE apply #-}
 
 
 recover :: (err -> Task err2 value) -> Task err value -> Task err2 value
 recover f self = Task (Except.catchE (runTask self) (runTask <. f))
+{-# INLINE recover #-}
 
 
 asResult :: Task err value -> Task err2 (Result err value)
 asResult task =
   runResult task
     |> fromIO
+{-# INLINE asResult #-}
 
 
 andThen :: (input -> Task err output) -> Task err input -> Task err output
 andThen f self = Task do
   value <- runTask self
   runTask (f value)
+{-# INLINE andThen #-}
 
 
 -- TODO: Figure out the best API to ensure that the main function is just a Task that cannot fail and returns a unit
@@ -100,6 +108,7 @@ runResult task = do
   runTask task
     |> Except.runExceptT
     |> IO.map Result.fromEither
+{-# INLINE runResult #-}
 
 
 run :: (Result err value -> IO value) -> Task err value -> IO value
@@ -109,6 +118,7 @@ run reducer task = do
     |> IO.map Result.fromEither
     |> IO.andThen reducer
     |> withUtf8
+{-# INLINE run #-}
 
 
 runNoErrors :: Task Never value -> IO value
@@ -120,15 +130,19 @@ runNoErrors task = do
     |> IO.map Result.fromEither
     |> IO.andThen reducer
     |> withUtf8
+{-# INLINE runNoErrors #-}
 
 
-runOrPanic :: (Show err) => Task err value -> IO value
+runOrPanic :: (HasCallStack, Show err) => Task err value -> IO value
 runOrPanic task = do
-  let reducer (Result.Ok value) = IO.yield value
-      reducer (Result.Err err) = panic (toPrettyText err)
+  let reducer result = case result of
+        Result.Ok value -> IO.yield value
+        Result.Err err -> panic (toPrettyText err)
+      {-# INLINE reducer #-}
   task
     |> run reducer
     |> withUtf8
+{-# INLINE runOrPanic #-}
 
 
 runMain :: Task Text Unit -> IO Unit
@@ -138,6 +152,7 @@ runMain task = do
   task
     |> run reducer
     |> withUtf8
+{-# INLINE runMain #-}
 
 
 -- fromFailableIO is the reverse of run
@@ -155,13 +170,15 @@ fromFailableIO io = do
   case result of
     Either.Left exception -> throw exception
     Either.Right value -> yield value
+{-# INLINE fromFailableIO #-}
 
 
 fromIO :: IO value -> Task _ value
 fromIO io =
   io
     |> Monad.liftIO
     |> Task
+{-# INLINE fromIO #-}
 
 
 fromIOResult :: (Show err) => IO (Result err value) -> Task err value
@@ -170,6 +187,7 @@ fromIOResult io =
     |> Prelude.fmap Result.toEither
     |> Except.ExceptT
     |> Task
+{-# INLINE fromIOResult #-}
 
 
 forEach ::
@@ -179,13 +197,15 @@ forEach ::
   Task err Unit
 forEach callback array =
   Data.Foldable.traverse_ callback (Array.unwrap array)
+{-# INLINE forEach #-}
 
 
 mapArray :: (element -> Task err output) -> Array element -> Task err (Array output)
 mapArray f array =
   Array.unwrap array
     |> Control.Monad.mapM f
     |> Task.map Array.fromLegacy
+{-# INLINE mapArray #-}
 
 
 -- | Run a task if a condition is false
@@ -194,6 +214,7 @@ unless condition task =
   if condition
     then Applicable.pure unit
     else task
+{-# INLINE unless #-}
 
 
 -- | Run a task if a condition is true
@@ -202,3 +223,4 @@ when condition task =
   if condition
     then task
     else Applicable.pure unit
+{-# INLINE when #-}

core/nhcore.cabal

@@ -22,8 +22,6 @@ common common_cfg
       ghc-prim ,
       async ,
       aeson ,
-      brick ,
-      vty ,
       bytestring ,
       data-default ,
       text ,
@@ -98,7 +96,6 @@ library
       Unknown,
       Var,
       Task,
-      Toml,
 
       -- System
       File,
@@ -126,6 +123,9 @@ library
       -- Service
       Trigger,
       Service.Event,
+      Service.Event.EntityId,
+      Service.Event.StreamId,
+      Service.Event.StreamPosition,
       Service.EventStore,
       Service.EventStore.Core,
       Service.EventStore.InMemory,
@@ -153,6 +153,10 @@ library
       Test.Service.EventStore.IndividualStreamOrdering.Context,
       Test.Service.EventStore.OptimisticConcurrency.Spec,
       Test.Service.EventStore.OptimisticConcurrency.Context,
+      Test.Service.EventStore.ReadAllForwardsFromStart.Spec,
+      Test.Service.EventStore.ReadAllForwardsFromStart.Context,
+      Test.Service.EventStore.ReadAllBackwardsFromEnd.Spec,
+      Test.Service.EventStore.ReadAllBackwardsFromEnd.Context,
 
     -- other-modules:
     -- other-extensions:
@@ -161,7 +165,6 @@ library
       concurrency,
       service,
       json,
-      toml,
       traits,
       system,
       http,

core/service/Service/Event.hs

@@ -1,29 +1,44 @@
 module Service.Event (
   Event (..),
+  InsertionEvent (..),
   StreamId (..),
   StreamPosition (..),
+  EntityId (..),
+  fromInsertionEvent,
 ) where
 
 import Core
+import Service.Event.EntityId (EntityId (..))
+import Service.Event.StreamId (StreamId (..))
+import Service.Event.StreamPosition (StreamPosition (..))
 
 
 data Event = Event
-  { id :: Text, -- FIXME: Use Uuid
+  { id :: Uuid,
     streamId :: StreamId,
-    position :: StreamPosition, -- Local position in stream
-
-    -- | Global position across all streams. Nothing when event is created
-    -- but not yet persisted to the global stream; Just when assigned a
-    -- position in the global event ordering. Used for global event queries
-    -- and maintaining causal ordering across different streams.
-    globalPosition :: Maybe StreamPosition
+    entityId :: EntityId,
+    localPosition :: StreamPosition,
+    globalPosition :: StreamPosition
   }
   deriving (Eq, Show, Ord, Generic)
 
 
-newtype StreamId = StreamId Text
+data InsertionEvent = InsertionEvent
+  { id :: Uuid,
+    streamId :: StreamId,
+    entityId :: EntityId,
+    localPosition :: StreamPosition
+  }
   deriving (Eq, Show, Ord, Generic)
 
 
-newtype StreamPosition = StreamPosition (Positive Int)
-  deriving (Eq, Show, Ord, Generic)
+-- | Convert an insertion event to an event with a global position.
+fromInsertionEvent :: StreamPosition -> InsertionEvent -> Event
+fromInsertionEvent globalPosition event =
+  Event
+    { id = event.id,
+      streamId = event.streamId,
+      entityId = event.entityId,
+      localPosition = event.localPosition,
+      globalPosition
+    }

core/service/Service/Event/EntityId.hs

@@ -0,0 +1,18 @@
+module Service.Event.EntityId (
+  EntityId (..),
+  new,
+) where
+
+import Core
+import Task qualified
+import Uuid qualified
+
+
+newtype EntityId = EntityId Uuid
+  deriving (Eq, Show, Ord, Generic)
+
+
+new :: Task _ EntityId
+new = do
+  uuid <- Uuid.generate
+  EntityId uuid |> Task.yield