Skip to content

Commit

Permalink
v0.3.0 - Triggers and renaming (#103)
Browse files Browse the repository at this point in the history
* 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]>
  • Loading branch information
Nick Seagull and NickSeagull authored Aug 4, 2024
1 parent 9dae30a commit 650610e
Show file tree
Hide file tree
Showing 16 changed files with 557 additions and 420 deletions.
4 changes: 3 additions & 1 deletion .vscode/settings.json
Original file line number Diff line number Diff line change
Expand Up @@ -10,10 +10,12 @@
"fprint",
"GADT",
"Monoid",
"Nanotime",
"NEOHASKELL",
"NOINLINE",
"optparse",
"OVERLAPPABLE",
"Posix",
"reldir",
"relfile",
"Semigroup",
Expand All @@ -23,4 +25,4 @@
],
"haskell.manageHLS": "PATH",
"nixEnvSelector.nixFile": "${workspaceFolder}/devenv.nix"
}
}
26 changes: 6 additions & 20 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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)?
65 changes: 48 additions & 17 deletions cli/src/Neo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
)
6 changes: 5 additions & 1 deletion core/concurrency/AsyncIO.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
1 change: 1 addition & 0 deletions core/core/Basics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -119,6 +119,7 @@ module Basics
Control.Monad.join,
Type,
ifThenElse,
Control.Monad.forever,
)
where

Expand Down
5 changes: 3 additions & 2 deletions core/core/Core.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
20 changes: 13 additions & 7 deletions core/nhcore.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ common common_cfg
containers,
opt-env-conf,
path,
nanotime,
process,
large-anon,
pretty-simple,
Expand Down Expand Up @@ -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,

Expand All @@ -110,10 +114,11 @@ library
Thenable,
ToText,

-- Platform
Command,
-- Service
Action,
Html,
Platform,
Service,
Trigger,

-- Concurrency
AsyncIO,
Expand All @@ -126,10 +131,11 @@ library
hs-source-dirs:
core,
concurrency,
platform,
service,
json,
yaml,
traits,
system,
options-parser
default-language: GHC2021

Expand Down
Loading

0 comments on commit 650610e

Please sign in to comment.