0.4.0 - Command parsing actions, bug fixing and refactors (#113)

* wip

* wip

* Proper Arg parsing support through actions

* Fix worker order

* wip

* At least it can get interrupted now

* It works!

* Fix buggy VTY

* Extract RuntimeState

* Add text interpolation

* Replace another string

* Refactor service module

* Bump versions

---------

Co-authored-by: Nick Seagull <[email protected]>

cli/nhcli.cabal

@@ -1,6 +1,6 @@
 cabal-version:      3.4
 name:               nhcli
-version:            0.1.0
+version:            0.3.1
 synopsis:           Command Line Tool for NeoHaskell
 -- description:
 homepage:           https://neohaskell.org

cli/src/Neo.hs

@@ -1,116 +1,115 @@
-{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-}
-
 module Neo (main) where
 
 import Action qualified
+import Array (Array)
 import Array qualified
+import Command qualified
 import Core
-import File qualified
-import Result qualified
+import Path qualified
 import Service qualified
-import ToText (Show)
-import Time qualified
-import Yaml qualified
+import ToText (Show (..))
 
 
-type Model =
+type State =
   Record
-    '[ "project" := Maybe ProjectDefinition,
-       "path" := Maybe Path,
-       "count" := Int,
-       "status" := Text
+    '[ "foo" := Text,
+       "bar" := Text
      ]
 
 
-type ProjectDefinition =
+data Event
+  = Transpile TranspilationStartedEvent
+  | NoOp
+  deriving (Show, Eq, Ord)
+
+
+type TranspilationStartedEvent =
   Record
-    '[ "name" := Text,
-       "version" := Version
+    '[ "inputPath" := Path,
+       "outputPath" := Path
      ]
 
 
-data Event
-  = ProjectFileRead Text
-  | ProjectFileAccessErrored File.Error
-  | ProjectFileParsed ProjectDefinition
-  | BuildStarted
-  | Tick
-  | BuildFailed FailureReason
-  deriving (Show)
+commandParser :: Command.OptionsParser Event
+commandParser = do
+  let transpile =
+        ANON
+          { name = "transpile",
+            description = "Transpile a file or directory",
+            version = Nothing,
+            decoder = transpileParser
+          }
+  Command.commands
+    (Array.fromLinkedList [transpile])
+
+
+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"
+        }
 
-data FailureReason
-  = ProjectFileParseError Text
-  deriving (Show)
+  pure ANON {inputPath = inputPath, outputPath = outputPath}
 
 
-init :: (Model, Action Event)
+init :: (State, Action Event)
 init = do
-  let emptyModel =
-        ANON
-          { project = Nothing,
-            path = Nothing,
-            count = 0,
-            status = "Starting up"
-          }
+  let emptyState = ANON {foo = "foo", bar = "bar"}
   let action =
-        File.readText
+        Command.parse
           ANON
-            { path = [path|project.yaml|],
-              onSuccess = ProjectFileRead,
-              onError = ProjectFileAccessErrored
+            { name = "neo",
+              description = "NeoHaskell's console helper",
+              version = Just [version|0.0.0|],
+              decoder = commandParser
             }
-  (emptyModel, action)
+  (emptyState, action)
 
 
-update :: Event -> Model -> (Model, Action Event)
-update event model =
+update :: Event -> State -> (State, Action Event)
+update event state =
   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, Action.continueWith (ProjectFileParsed projectDefinition))
-        Result.Err _ -> do
-          let error = ProjectFileParseError fileContent
-          (newModel, Action.continueWith (BuildFailed error))
-    ProjectFileAccessErrored _ ->
-      (model {status = "File Access Errored"}, Action.none)
-    ProjectFileParsed projectDefinition ->
-      (model {project = Just projectDefinition}, Action.none)
-    BuildStarted ->
-      (model {status = "Build Started!"}, Action.none)
-    BuildFailed _ ->
-      (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 ->
-      m.status ++ "\n\n" ++ toText project
-    Nothing ->
-      m.status
+    Transpile transpilationStartedEvent -> do
+      let newState = state {foo = "Transpilation started", bar = transpilationStartedEvent.inputPath |> Path.toText}
+      let action = Action.none
+      (newState, action)
+    NoOp -> do
+      let newState = state
+      let action = Action.none
+      (newState, action)
+
+
+view :: State -> Text
+view _ = "Hello, world!"
+
+
+triggers :: Array (Trigger Event)
+triggers = Array.empty
 
 
 main :: IO ()
-main =
-  Service.init
-    ( ANON
-        { init = (init),
-          view = (view),
-          triggers =
-            Array.fromLinkedList
-              [ Time.triggerEveryMilliseconds 1000 (\_ -> Tick)
-              ],
-          update = (update)
-        }
-    )
+main = do
+  let app :: Service.UserApp State Event
+      app =
+        ANON {init = init, view = view, triggers = triggers, update = update}
+  Service.init app

cli/src/Neo/Transpile.hs

@@ -0,0 +1,102 @@
+module Neo.Transpile () where
+
+import Action qualified
+import Array qualified
+import Core
+import File qualified
+import Result qualified
+import Service qualified
+import Time qualified
+import ToText (Show)
+
+
+type State =
+  Record
+    '[ "inputPath" := Path,
+       "outputPath" := Path,
+       "status" := Text
+     ]
+
+
+data Event
+  = InputFileRead Text
+  | InputFileAccessErrored File.Error
+  | TranspilationCompleted Text
+  | TranspilationFailed FailureReason
+  | OutputFileWritten
+  | OutputFileWriteErrored File.Error
+  deriving (Show)
+
+
+data FailureReason
+  = TranspilationError Text
+  deriving (Show)
+
+
+init :: (State, Action Event)
+init = do
+  let emptyState =
+        ANON
+          { inputPath = Nothing,
+            outputPath = Nothing,
+            status = "Starting up"
+          }
+  let action =
+        File.readText
+          ANON
+            { path = [path|inputPath.txt|],
+              onSuccess = InputFileRead,
+              onError = InputFileAccessErrored
+            }
+  (emptyState, action)
+
+
+update :: Event -> State -> (State, Action Event)
+update event state =
+  case event of
+    InputFileRead fileContent -> do
+      let newState = state {inputPath = Just fileContent, status = "Transpiling..."}
+      let transpiled = transpile fileContent
+      (newState, Action.continueWith (TranspilationCompleted transpiled))
+    InputFileAccessErrored _ ->
+      (state {status = "Input File Access Errored"}, Action.none)
+    TranspilationCompleted transpiledContent -> do
+      let newState = state {outputPath = Just transpiledContent, status = "Writing output..."}
+      let action =
+            File.writeText
+              ANON
+                { path = [path|outputPath.txt|],
+                  content = transpiledContent,
+                  onSuccess = \_ -> OutputFileWritten,
+                  onError = OutputFileWriteErrored
+                }
+      (newState, action)
+    TranspilationFailed reason ->
+      (state {status = "Transpilation Failed: " ++ toText reason}, Action.none)
+    OutputFileWritten ->
+      (state {status = "Transpilation Completed"}, Action.none)
+    OutputFileWriteErrored _ ->
+      (state {status = "Output File Write Errored"}, Action.none)
+
+
+view :: State -> Text
+view state = state.status
+
+
+transpile :: Text -> Text
+transpile input =
+  -- This is a placeholder for the actual transpilation logic
+  -- In a real-world scenario, you'd implement your transpilation rules here
+  "Transpiled: " ++ input
+
+
+main :: IO ()
+main =
+  Service.init
+    ( ANON
+        { init = init,
+          view = view,
+          update = update,
+          triggers = Array.empty
+        }
+    )

core/concurrency/AsyncIO.hs

@@ -1,8 +1,13 @@
-module AsyncIO (AsyncIO, run, waitFor, sleep) where
+module AsyncIO (AsyncIO, run, waitFor, sleep, process, waitAnyCancel, withRecovery, cancel) where
 
+import Array (Array)
+import Array qualified
 import Basics
 import Control.Concurrent qualified as Ghc
 import Control.Concurrent.Async qualified as GhcAsync
+import Data.Either qualified as Either
+import Result (Result)
+import Result qualified
 
 
 type AsyncIO result = GhcAsync.Async result
@@ -16,5 +21,29 @@ waitFor :: AsyncIO result -> IO result
 waitFor = GhcAsync.wait
 
 
+process :: IO a -> (AsyncIO a -> IO b) -> IO b
+process = GhcAsync.withAsync
+
+
 sleep :: Int -> IO Unit
-sleep milliseconds = Ghc.threadDelay (milliseconds * 1000)
+sleep milliseconds = Ghc.threadDelay (milliseconds * 1000)
+
+
+withRecovery :: IO error -> IO result -> IO (Result error result)
+withRecovery errorIO resultIO = do
+  result <- GhcAsync.race errorIO resultIO
+  case result of
+    Either.Left a -> pure (Result.Err a)
+    Either.Right a -> pure (Result.Ok a)
+
+
+waitAnyCancel :: Array (AsyncIO a) -> IO (AsyncIO a, a)
+waitAnyCancel arr = do
+  let asyncList =
+        Array.toLinkedList arr
+  (async, result) <- GhcAsync.waitAnyCancel asyncList
+  pure (async, result)
+
+
+cancel :: AsyncIO a -> IO ()
+cancel = GhcAsync.cancel