NeoHaskell v0.5.0: Nested Actions Now Executed and Major Refactoring

cli/nhcli.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.4
 name:               nhcli
-version:            0.3.1
+version:            0.5.0
 synopsis:           Command Line Tool for NeoHaskell
 -- description:
 homepage:           https://neohaskell.org
@@ -15,7 +15,6 @@ build-type:         Simple
 common common_cfg
     ghc-options:    -Wall
                     -Werror
-                    -fplugin=Data.Record.Anon.Plugin
                     -threaded
     default-extensions:
       ApplicativeDo
@@ -32,8 +31,6 @@ common common_cfg
       OverloadedLists
       OverloadedLabels
       OverloadedRecordDot
-      OverloadedRecordUpdate
-      RebindableSyntax
       DuplicateRecordFields
       PackageImports
       NamedFieldPuns
@@ -42,12 +39,12 @@ common common_cfg
 
     build-depends:
       nhcore,
-      large-anon,
 
 library
     import:           common_cfg
     exposed-modules:
       Neo,
+      Neo.Build,
     -- other-modules:
     -- other-extensions:
     hs-source-dirs:   src
@@ -62,7 +59,6 @@ executable neo
         nhcli
     ghc-options:    -Wall
                     -Werror
-                    -fplugin=Data.Record.Anon.Plugin
     hs-source-dirs:   app
     default-language: GHC2021
 

cli/src/Neo.hs

@@ -5,82 +5,50 @@ import Array (Array)
 import Array qualified
 import Command qualified
 import Core
-import Path qualified
+import Neo.Build qualified as Build
 import Service qualified
-import ToText (Show (..))
 
 
-type State =
-  Record
-    '[ "foo" := Text,
-       "bar" := Text
-     ]
+data State = State
+  { build :: Build.State
+  }
+  deriving (Show, Eq, Ord)
 
 
 data Event
-  = Transpile TranspilationStartedEvent
+  = Build Build.Event
   | NoOp
   deriving (Show, Eq, Ord)
 
 
-type TranspilationStartedEvent =
-  Record
-    '[ "inputPath" := Path,
-       "outputPath" := Path
-     ]
-
-
 commandParser :: Command.OptionsParser Event
 commandParser = do
-  let transpile =
-        ANON
-          { name = "transpile",
-            description = "Transpile a file or directory",
+  let build =
+        Command.CommandOptions
+          { name = "build",
+            description = "build a file or directory",
             version = Nothing,
-            decoder = transpileParser
+            decoder = buildParser
           }
   Command.commands
-    (Array.fromLinkedList [transpile])
-
+    (Array.fromLinkedList [build])
 
-transpileParser :: Command.OptionsParser Event
-transpileParser = do
-  event <- transpilationParser
-  pure (Transpile event)
 
-
-transpilationParser :: Command.OptionsParser TranspilationStartedEvent
-transpilationParser = do
-  inputPath <-
-    Command.path
-      ANON
-        { help = "Path to the input file or directory",
-          long = "input",
-          short = 'i',
-          metavar = "PATH"
-        }
-
-  outputPath <-
-    Command.path
-      ANON
-        { help = "Path to the output file or directory",
-          long = "output",
-          short = 'o',
-          metavar = "PATH"
-        }
-
-  pure ANON {inputPath = inputPath, outputPath = outputPath}
+buildParser :: Command.OptionsParser Event
+buildParser = do
+  event <- Build.commandParser
+  pure (Build event)
 
 
 init :: (State, Action Event)
 init = do
-  let emptyState = ANON {foo = "foo", bar = "bar"}
+  let emptyState = State {build = Build.initialState}
   let action =
         Command.parse
-          ANON
+          Command.CommandOptions
             { name = "neo",
               description = "NeoHaskell's console helper",
-              version = Just [version|0.0.0|],
+              version = Just [version|0.5.0|],
               decoder = commandParser
             }
   (emptyState, action)
@@ -89,9 +57,10 @@ init = do
 update :: Event -> State -> (State, Action Event)
 update event state =
   case event of
-    Transpile transpilationStartedEvent -> do
-      let newState = state {foo = "Transpilation started", bar = transpilationStartedEvent.inputPath |> Path.toText}
-      let action = Action.none
+    Build buildEvent -> do
+      let (newBuildState, buildAction) = Build.update buildEvent state.build
+      let newState = state {build = newBuildState}
+      let action = buildAction |> Action.map Build
       (newState, action)
     NoOp -> do
       let newState = state
@@ -100,16 +69,22 @@ update event state =
 
 
 view :: State -> Text
-view _ = "Hello, world!"
+view s =
+  if s.build.message == ""
+    then "Loading"
+    else s.build.message
 
 
 triggers :: Array (Trigger Event)
 triggers = Array.empty
 
 
 main :: IO ()
-main = do
-  let app :: Service.UserApp State Event
-      app =
-        ANON {init = init, view = view, triggers = triggers, update = update}
-  Service.init app
+main =
+  Service.run
+    Service.UserApp
+      { init = init,
+        view = view,
+        triggers = triggers,
+        update = update
+      }

cli/src/Neo/Build.hs

@@ -0,0 +1,66 @@
+module Neo.Build (
+  Event,
+  BuildEvent (..),
+  State (..),
+  commandParser,
+  initialState,
+  update,
+  view,
+) where
+
+import Action qualified
+import Command qualified
+import Core
+import File qualified
+
+
+type Event = BuildEvent
+
+
+data BuildEvent
+  = BuildStarted
+  | ProjectFileNotFound
+  | ReadProjectFile Text
+  deriving (Show, Eq, Ord)
+
+
+commandParser :: Command.OptionsParser BuildEvent
+commandParser = do
+  pure BuildStarted
+
+
+data State = State
+  { message :: Text
+  }
+  deriving (Show, Eq, Ord)
+
+
+initialState :: State
+initialState =
+  State
+    { message = "Build Started"
+    }
+
+
+update :: BuildEvent -> State -> (State, Action BuildEvent)
+update event state =
+  case event of
+    BuildStarted -> do
+      let handleRes res = case res of
+            Ok text -> ReadProjectFile text
+            Err _ -> ProjectFileNotFound
+      let opts =
+            File.ReadOptions
+              { path = "foo.txt"
+              }
+      (state, File.readText opts |> Action.map handleRes)
+    ReadProjectFile text -> do
+      let newState = state {message = text}
+      (newState, Action.none)
+    ProjectFileNotFound -> do
+      let newState = state {message = "Project file not found"}
+      (newState, Action.none)
+
+
+view :: State -> View
+view = dieWith "Not implemented yet"

core/concurrency/AsyncIO.hs

@@ -6,6 +6,7 @@ import Basics
 import Control.Concurrent qualified as Ghc
 import Control.Concurrent.Async qualified as GhcAsync
 import Data.Either qualified as Either
+import IO (IO)
 import Result (Result)
 import Result qualified