Skip to content

Commit 714a27c

Browse files
Nick SeagullNick Seagull
Nick Seagull
and
Nick Seagull
authored
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]>
1 parent 650610e commit 714a27c

File tree

18 files changed

+1107
-605
lines changed

18 files changed

+1107
-605
lines changed

‎cli/nhcli.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 3.4
22
name: nhcli
3-
version: 0.1.0
3+
version: 0.3.1
44
synopsis: Command Line Tool for NeoHaskell
55
-- description:
66
homepage: https://neohaskell.org

‎cli/src/Neo.hs

Lines changed: 85 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -1,116 +1,115 @@
1-
{-# OPTIONS_GHC -fplugin=Data.Record.Anon.Plugin #-}
2-
31
module Neo (main) where
42

53
import Action qualified
4+
import Array (Array)
65
import Array qualified
6+
import Command qualified
77
import Core
8-
import File qualified
9-
import Result qualified
8+
import Path qualified
109
import Service qualified
11-
import ToText (Show)
12-
import Time qualified
13-
import Yaml qualified
10+
import ToText (Show (..))
1411

1512

16-
type Model =
13+
type State =
1714
Record
18-
'[ "project" := Maybe ProjectDefinition,
19-
"path" := Maybe Path,
20-
"count" := Int,
21-
"status" := Text
15+
'[ "foo" := Text,
16+
"bar" := Text
2217
]
2318

2419

25-
type ProjectDefinition =
20+
data Event
21+
= Transpile TranspilationStartedEvent
22+
| NoOp
23+
deriving (Show, Eq, Ord)
24+
25+
26+
type TranspilationStartedEvent =
2627
Record
27-
'[ "name" := Text,
28-
"version" := Version
28+
'[ "inputPath" := Path,
29+
"outputPath" := Path
2930
]
3031

3132

32-
data Event
33-
= ProjectFileRead Text
34-
| ProjectFileAccessErrored File.Error
35-
| ProjectFileParsed ProjectDefinition
36-
| BuildStarted
37-
| Tick
38-
| BuildFailed FailureReason
39-
deriving (Show)
33+
commandParser :: Command.OptionsParser Event
34+
commandParser = do
35+
let transpile =
36+
ANON
37+
{ name = "transpile",
38+
description = "Transpile a file or directory",
39+
version = Nothing,
40+
decoder = transpileParser
41+
}
42+
Command.commands
43+
(Array.fromLinkedList [transpile])
44+
45+
46+
transpileParser :: Command.OptionsParser Event
47+
transpileParser = do
48+
event <- transpilationParser
49+
pure (Transpile event)
50+
4051

52+
transpilationParser :: Command.OptionsParser TranspilationStartedEvent
53+
transpilationParser = do
54+
inputPath <-
55+
Command.path
56+
ANON
57+
{ help = "Path to the input file or directory",
58+
long = "input",
59+
short = 'i',
60+
metavar = "PATH"
61+
}
62+
63+
outputPath <-
64+
Command.path
65+
ANON
66+
{ help = "Path to the output file or directory",
67+
long = "output",
68+
short = 'o',
69+
metavar = "PATH"
70+
}
4171

42-
data FailureReason
43-
= ProjectFileParseError Text
44-
deriving (Show)
72+
pure ANON {inputPath = inputPath, outputPath = outputPath}
4573

4674

47-
init :: (Model, Action Event)
75+
init :: (State, Action Event)
4876
init = do
49-
let emptyModel =
50-
ANON
51-
{ project = Nothing,
52-
path = Nothing,
53-
count = 0,
54-
status = "Starting up"
55-
}
77+
let emptyState = ANON {foo = "foo", bar = "bar"}
5678
let action =
57-
File.readText
79+
Command.parse
5880
ANON
59-
{ path = [path|project.yaml|],
60-
onSuccess = ProjectFileRead,
61-
onError = ProjectFileAccessErrored
81+
{ name = "neo",
82+
description = "NeoHaskell's console helper",
83+
version = Just [version|0.0.0|],
84+
decoder = commandParser
6285
}
63-
(emptyModel, action)
86+
(emptyState, action)
6487

6588

66-
update :: Event -> Model -> (Model, Action Event)
67-
update event model =
89+
update :: Event -> State -> (State, Action Event)
90+
update event state =
6891
case event of
69-
ProjectFileRead fileContent -> do
70-
let parsedContent = Yaml.parse fileContent
71-
let newModel = model {status = "Parsing project file"}
72-
case parsedContent of
73-
Result.Ok projectDefinition ->
74-
(newModel, Action.continueWith (ProjectFileParsed projectDefinition))
75-
Result.Err _ -> do
76-
let error = ProjectFileParseError fileContent
77-
(newModel, Action.continueWith (BuildFailed error))
78-
ProjectFileAccessErrored _ ->
79-
(model {status = "File Access Errored"}, Action.none)
80-
ProjectFileParsed projectDefinition ->
81-
(model {project = Just projectDefinition}, Action.none)
82-
BuildStarted ->
83-
(model {status = "Build Started!"}, Action.none)
84-
BuildFailed _ ->
85-
(model {status = "Build Failed!"}, Action.none)
86-
Tick ->
87-
( model
88-
{ count = model.count + 1,
89-
status = "Count: " ++ toText model.count
90-
},
91-
Action.none
92-
)
93-
94-
95-
view :: Model -> Text
96-
view m =
97-
case m.project of
98-
Just project ->
99-
m.status ++ "\n\n" ++ toText project
100-
Nothing ->
101-
m.status
92+
Transpile transpilationStartedEvent -> do
93+
let newState = state {foo = "Transpilation started", bar = transpilationStartedEvent.inputPath |> Path.toText}
94+
let action = Action.none
95+
(newState, action)
96+
NoOp -> do
97+
let newState = state
98+
let action = Action.none
99+
(newState, action)
100+
101+
102+
view :: State -> Text
103+
view _ = "Hello, world!"
104+
105+
106+
triggers :: Array (Trigger Event)
107+
triggers = Array.empty
102108

103109

104110
main :: IO ()
105-
main =
106-
Service.init
107-
( ANON
108-
{ init = (init),
109-
view = (view),
110-
triggers =
111-
Array.fromLinkedList
112-
[ Time.triggerEveryMilliseconds 1000 (\_ -> Tick)
113-
],
114-
update = (update)
115-
}
116-
)
111+
main = do
112+
let app :: Service.UserApp State Event
113+
app =
114+
ANON {init = init, view = view, triggers = triggers, update = update}
115+
Service.init app

‎cli/src/Neo/Transpile.hs

Lines changed: 102 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,102 @@
1+
module Neo.Transpile () where
2+
3+
import Action qualified
4+
import Array qualified
5+
import Core
6+
import File qualified
7+
import Result qualified
8+
import Service qualified
9+
import Time qualified
10+
import ToText (Show)
11+
12+
13+
type State =
14+
Record
15+
'[ "inputPath" := Path,
16+
"outputPath" := Path,
17+
"status" := Text
18+
]
19+
20+
21+
data Event
22+
= InputFileRead Text
23+
| InputFileAccessErrored File.Error
24+
| TranspilationCompleted Text
25+
| TranspilationFailed FailureReason
26+
| OutputFileWritten
27+
| OutputFileWriteErrored File.Error
28+
deriving (Show)
29+
30+
31+
data FailureReason
32+
= TranspilationError Text
33+
deriving (Show)
34+
35+
36+
init :: (State, Action Event)
37+
init = do
38+
let emptyState =
39+
ANON
40+
{ inputPath = Nothing,
41+
outputPath = Nothing,
42+
status = "Starting up"
43+
}
44+
let action =
45+
File.readText
46+
ANON
47+
{ path = [path|inputPath.txt|],
48+
onSuccess = InputFileRead,
49+
onError = InputFileAccessErrored
50+
}
51+
(emptyState, action)
52+
53+
54+
update :: Event -> State -> (State, Action Event)
55+
update event state =
56+
case event of
57+
InputFileRead fileContent -> do
58+
let newState = state {inputPath = Just fileContent, status = "Transpiling..."}
59+
let transpiled = transpile fileContent
60+
(newState, Action.continueWith (TranspilationCompleted transpiled))
61+
InputFileAccessErrored _ ->
62+
(state {status = "Input File Access Errored"}, Action.none)
63+
TranspilationCompleted transpiledContent -> do
64+
let newState = state {outputPath = Just transpiledContent, status = "Writing output..."}
65+
let action =
66+
File.writeText
67+
ANON
68+
{ path = [path|outputPath.txt|],
69+
content = transpiledContent,
70+
onSuccess = \_ -> OutputFileWritten,
71+
onError = OutputFileWriteErrored
72+
}
73+
(newState, action)
74+
TranspilationFailed reason ->
75+
(state {status = "Transpilation Failed: " ++ toText reason}, Action.none)
76+
OutputFileWritten ->
77+
(state {status = "Transpilation Completed"}, Action.none)
78+
OutputFileWriteErrored _ ->
79+
(state {status = "Output File Write Errored"}, Action.none)
80+
81+
82+
view :: State -> Text
83+
view state = state.status
84+
85+
86+
transpile :: Text -> Text
87+
transpile input =
88+
-- This is a placeholder for the actual transpilation logic
89+
-- In a real-world scenario, you'd implement your transpilation rules here
90+
"Transpiled: " ++ input
91+
92+
93+
main :: IO ()
94+
main =
95+
Service.init
96+
( ANON
97+
{ init = init,
98+
view = view,
99+
update = update,
100+
triggers = Array.empty
101+
}
102+
)

‎core/concurrency/AsyncIO.hs

Lines changed: 31 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,13 @@
1-
module AsyncIO (AsyncIO, run, waitFor, sleep) where
1+
module AsyncIO (AsyncIO, run, waitFor, sleep, process, waitAnyCancel, withRecovery, cancel) where
22

3+
import Array (Array)
4+
import Array qualified
35
import Basics
46
import Control.Concurrent qualified as Ghc
57
import Control.Concurrent.Async qualified as GhcAsync
8+
import Data.Either qualified as Either
9+
import Result (Result)
10+
import Result qualified
611

712

813
type AsyncIO result = GhcAsync.Async result
@@ -16,5 +21,29 @@ waitFor :: AsyncIO result -> IO result
1621
waitFor = GhcAsync.wait
1722

1823

24+
process :: IO a -> (AsyncIO a -> IO b) -> IO b
25+
process = GhcAsync.withAsync
26+
27+
1928
sleep :: Int -> IO Unit
20-
sleep milliseconds = Ghc.threadDelay (milliseconds * 1000)
29+
sleep milliseconds = Ghc.threadDelay (milliseconds * 1000)
30+
31+
32+
withRecovery :: IO error -> IO result -> IO (Result error result)
33+
withRecovery errorIO resultIO = do
34+
result <- GhcAsync.race errorIO resultIO
35+
case result of
36+
Either.Left a -> pure (Result.Err a)
37+
Either.Right a -> pure (Result.Ok a)
38+
39+
40+
waitAnyCancel :: Array (AsyncIO a) -> IO (AsyncIO a, a)
41+
waitAnyCancel arr = do
42+
let asyncList =
43+
Array.toLinkedList arr
44+
(async, result) <- GhcAsync.waitAnyCancel asyncList
45+
pure (async, result)
46+
47+
48+
cancel :: AsyncIO a -> IO ()
49+
cancel = GhcAsync.cancel

0 commit comments

Comments
 (0)