v0.3.0 - Triggers and renaming (#103)

* Start working in subscriptions

* Implement basic subscriptions type

* Remove unused import

* Update

* update

* Update

* Fix format

* Rename command to action

* Rename to service

* Change FIXME comment

* Refactor

* Rename msg to event

* Update

* Update readme

---------

Co-authored-by: NickSeagull <[email protected]>

Author: Nick Seagull

.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"
-}
+}

README.md

@@ -11,17 +11,6 @@
 
 ---
 
-# Welcome
-
-This is where the NeoHaskell code will live, once the implementation begins.
-
-If you're confused, this is because the project prioritizes the design and documentation first, and only implementation afterwards!
-
-Take a look at the [GitHub Milestones page](https://github.com/neohaskell/NeoHaskell/milestones) for a rough plan for the implementation.
-
-Design documents are being worked on currently for sharing progress in a stable way with the community. Sorry for the inconvenience! 🙏
-
-<!--
 # Welcome to the contributor guide
 
 If you want to learn about NeoHaskell itself, checkout
@@ -35,27 +24,24 @@ different parts of NeoHaskell.
 
 # Installing the required tools
 
-- Install GHCUP by following [the official instructions](https://www.haskell.org/ghcup/).
-- Run `ghcup tui` and press `s` on the following options:
-  - GHC 9.2.8
-  - Cabal 3.10.1.0
-  - HLS 2.2.0.0
-  - (When prompted for download, press `y` to accept)
+(This assumes that you're using MacOS, WSL2 or Linux)
+
+- Install DevEnv by following [the official instructions](https://devenv.sh/getting-started/).
+- Run `devenv shell`
+- Run `cabal update && cabal build all`
 
 The recommended IDE for any NeoHaskell project is [Visual Studio Code](https://code.visualstudio.com/).
 
 # Get the code
 
 - Fork this repository
 - `git clone <url to your fork>`
-- `cd neohaskell && code .`
+- `cd NeoHaskell && code .`
 
 # Install the recommended extensions
 
 When opening the project for the first time, you will be prompted to install the recommended extensions, install them.
 
--->
-
 # Collaborate on Discord
 
 It's always better to hack with people, so why not join the [Discord server](https://discord.gg/invite/wDj3UYzec8)?

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/concurrency/AsyncIO.hs

@@ -4,13 +4,17 @@ import Basics
 import Control.Concurrent qualified as Ghc
 import Control.Concurrent.Async qualified as GhcAsync
 
+
 type AsyncIO result = GhcAsync.Async result
 
+
 run :: IO result -> IO (AsyncIO result)
 run = GhcAsync.async
 
+
 waitFor :: AsyncIO result -> IO result
 waitFor = GhcAsync.wait
 
+
 sleep :: Int -> IO Unit
-sleep microseconds = Ghc.threadDelay microseconds
+sleep milliseconds = Ghc.threadDelay (milliseconds * 1000)

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