feat: Triggers

.vscode/settings.json

@@ -10,10 +10,12 @@
     "fprint",
     "GADT",
     "Monoid",
+    "Nanotime",
     "NEOHASKELL",
     "NOINLINE",
     "optparse",
     "OVERLAPPABLE",
+    "Posix",
     "reldir",
     "relfile",
     "Semigroup",
@@ -23,4 +25,4 @@
   ],
   "haskell.manageHLS": "PATH",
   "nixEnvSelector.nixFile": "${workspaceFolder}/devenv.nix"
-}
+}

cli/src/Neo.hs

@@ -2,84 +2,115 @@
 
 module Neo (main) where
 
-import Command qualified
+import Action qualified
+import Array qualified
 import Core
 import File qualified
-import Platform qualified
 import Result qualified
+import Service qualified
 import ToText (Show)
+import Time qualified
 import Yaml qualified
 
+
 type Model =
   Record
     '[ "project" := Maybe ProjectDefinition,
        "path" := Maybe Path,
+       "count" := Int,
        "status" := Text
      ]
 
+
 type ProjectDefinition =
   Record
     '[ "name" := Text,
        "version" := Version
      ]
 
-data Message
+
+data Event
   = ProjectFileRead Text
   | ProjectFileAccessErrored File.Error
   | ProjectFileParsed ProjectDefinition
   | BuildStarted
+  | Tick
   | BuildFailed FailureReason
   deriving (Show)
 
+
 data FailureReason
   = ProjectFileParseError Text
   deriving (Show)
 
-init :: (Model, Command Message)
+
+init :: (Model, Action Event)
 init = do
   let emptyModel =
         ANON
           { project = Nothing,
             path = Nothing,
+            count = 0,
             status = "Starting up"
           }
-  let command =
+  let action =
         File.readText
           ANON
             { path = [path|project.yaml|],
               onSuccess = ProjectFileRead,
               onError = ProjectFileAccessErrored
             }
-  (emptyModel, command)
+  (emptyModel, action)
+
 
-update :: Message -> Model -> (Model, Command Message)
-update message model =
-  case message of
+update :: Event -> Model -> (Model, Action Event)
+update event model =
+  case event of
     ProjectFileRead fileContent -> do
       let parsedContent = Yaml.parse fileContent
       let newModel = model {status = "Parsing project file"}
       case parsedContent of
         Result.Ok projectDefinition ->
-          (newModel, Command.continueWith (ProjectFileParsed projectDefinition))
+          (newModel, Action.continueWith (ProjectFileParsed projectDefinition))
         Result.Err _ -> do
           let error = ProjectFileParseError fileContent
-          (newModel, Command.continueWith (BuildFailed error))
+          (newModel, Action.continueWith (BuildFailed error))
     ProjectFileAccessErrored _ ->
-      (model {status = "File Access Errored"}, Command.none)
+      (model {status = "File Access Errored"}, Action.none)
     ProjectFileParsed projectDefinition ->
-      (model {project = Just projectDefinition}, Command.none)
+      (model {project = Just projectDefinition}, Action.none)
     BuildStarted ->
-      (model {status = "Build Started!"}, Command.none)
+      (model {status = "Build Started!"}, Action.none)
     BuildFailed _ ->
-      (model {status = "Build Failed!"}, Command.none)
+      (model {status = "Build Failed!"}, Action.none)
+    Tick ->
+      ( model
+          { count = model.count + 1,
+            status = "Count: " ++ toText model.count
+          },
+        Action.none
+      )
+
 
 view :: Model -> Text
 view m =
   case m.project of
     Just project ->
-      toText project
+      m.status ++ "\n\n" ++ toText project
     Nothing ->
       m.status
 
+
 main :: IO ()
-main = Platform.init (ANON {init = init, view = view, update = update})
+main =
+  Service.init
+    ( ANON
+        { init = (init),
+          view = (view),
+          triggers =
+            Array.fromLinkedList
+              [ Time.triggerEveryMilliseconds 1000 (\_ -> Tick)
+              ],
+          update = (update)
+        }
+    )

core/core/Basics.hs

@@ -119,6 +119,7 @@ module Basics
     Control.Monad.join,
     Type,
     ifThenElse,
+    Control.Monad.forever,
   )
 where
 

core/core/Core.hs

@@ -5,10 +5,10 @@ module Core (
   module Reexported,
 ) where
 
+import Action as Reexported (Action)
 import Appendable as Reexported ((++))
 import Basics as Reexported
 import Char as Reexported (Char)
-import Command as Reexported (Command)
 import ConcurrentVar as Reexported (ConcurrentVar)
 import Console as Reexported (print, readLine)
 import Default as Reexported (Default (..), defaultValue)
@@ -18,10 +18,11 @@ import LinkedList as Reexported (LinkedList)
 import Map as Reexported (Map)
 import Maybe as Reexported (Maybe (..))
 import Path as Reexported (Path, path)
-import Platform as Reexported (Platform)
 import Result as Reexported (Result)
+import Service as Reexported (Service)
 import Text as Reexported (Text)
 import ToText as Reexported (ToText, toText)
+import Trigger as Reexported (Trigger)
 import Unknown as Reexported (Unknown)
 import Var as Reexported (Var)
 import Version as Reexported (Version, version)

core/nhcore.cabal

@@ -33,6 +33,7 @@ common common_cfg
       containers,
       opt-env-conf,
       path,
+      nanotime,
       process,
       large-anon,
       pretty-simple,
@@ -80,18 +81,21 @@ library
       Unit,
       Tuple,
       Console,
-      Subprocess,
       Int,
       IO,
-      Path,
-      File,
       Maybe,
       Array,
       Version,
       Record,
       Unknown,
       Var,
 
+      -- System
+      File,
+      Subprocess,
+      Path,
+      Time,
+
       -- OptionsParser
       OptionsParser,
 
@@ -110,10 +114,11 @@ library
       Thenable,
       ToText,
 
-      -- Platform
-      Command,
+      -- Service
+      Action,
       Html,
-      Platform,
+      Service,
+      Trigger,
 
       -- Concurrency
       AsyncIO,
@@ -126,10 +131,11 @@ library
     hs-source-dirs:
       core,
       concurrency,
-      platform,
+      service,
       json,
       yaml,
       traits,
+      system,
       options-parser
     default-language: GHC2021