mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-12-15 01:52:42 +03:00
Types and conversion for Tank/Plum.
This commit is contained in:
parent
5b3ab33dac
commit
54fc5f6078
@ -29,9 +29,45 @@ import qualified Control.Monad.Fail as Fail
|
||||
data Nullable a = Nil | NotNil a
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
newtype Tour = Tour [Char]
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
newtype Tape = Tape ByteString
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
newtype Cord = Cord ByteString
|
||||
deriving newtype (Eq, Ord, Show)
|
||||
|
||||
type Tang = [Tank]
|
||||
|
||||
data Tank
|
||||
= TLeaf Tape
|
||||
| TPlum Plum
|
||||
| TPalm (Tape, Tape, Tape, Tape) [Tank]
|
||||
| TRose (Tape, Tape, Tape) [Tank]
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
type Tile = Cord
|
||||
|
||||
data WideFmt
|
||||
= WideFmt { delimit :: Tile, enclose :: Maybe (Tile, Tile) }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data TallFmt
|
||||
= TallFmt { intro :: Tile, indef :: Maybe (Tile, Tile) }
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data PlumFmt
|
||||
= PlumFmt (Maybe WideFmt) (Maybe TallFmt)
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
data Plum
|
||||
= PAtom Cord
|
||||
| PPara Tile [Cord]
|
||||
| PTree PlumFmt [Plum]
|
||||
| PSbrk Plum
|
||||
deriving (Eq, Ord, Show)
|
||||
|
||||
|
||||
-- IResult ---------------------------------------------------------------------
|
||||
|
||||
@ -294,6 +330,33 @@ instance FromNoun Cord where
|
||||
pure $ Cord (atom ^. pill . pillBS)
|
||||
|
||||
|
||||
-- Tank and Plum Conversion ----------------------------------------------------
|
||||
|
||||
instance ToNoun WideFmt where toNoun (WideFmt x xs) = toNoun (x, xs)
|
||||
instance ToNoun TallFmt where toNoun (TallFmt x xs) = toNoun (x, xs)
|
||||
instance ToNoun PlumFmt where toNoun (PlumFmt wide tall) = toNoun (wide, tall)
|
||||
|
||||
instance FromNoun WideFmt where parseNoun = fmap (uncurry WideFmt) . parseNoun
|
||||
instance FromNoun TallFmt where parseNoun = fmap (uncurry TallFmt) . parseNoun
|
||||
instance FromNoun PlumFmt where parseNoun = fmap (uncurry PlumFmt) . parseNoun
|
||||
|
||||
instance ToNoun Plum where
|
||||
toNoun = \case
|
||||
PAtom cord -> toNoun cord
|
||||
PPara t cs -> toNoun (Cord "para", t, cs)
|
||||
PTree f ps -> toNoun (Cord "tree", f, ps)
|
||||
PSbrk p -> toNoun (Cord "sbrk", p)
|
||||
|
||||
instance FromNoun Plum where
|
||||
parseNoun = undefined
|
||||
|
||||
instance ToNoun Tank where
|
||||
toNoun = undefined
|
||||
|
||||
instance FromNoun Tank where
|
||||
parseNoun = undefined
|
||||
|
||||
|
||||
-- Pair Conversion -------------------------------------------------------------
|
||||
|
||||
instance (ToNoun a, ToNoun b) => ToNoun (a, b) where
|
||||
|
@ -27,16 +27,21 @@ data Worker = Worker
|
||||
}
|
||||
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
-- Think about how to handle process exit
|
||||
-- Tear down subprocess on exit? (terminiteProcess)
|
||||
start :: IO Worker
|
||||
start = do
|
||||
-- Think about how to handle process exit
|
||||
-- Tear down subprocess on exit? (terminiteProcess)
|
||||
(Just stdin, Just stdout, _, ph) <-
|
||||
createProcess (proc "urbit-worker" []){ std_in = CreatePipe,
|
||||
std_out = CreatePipe }
|
||||
pure (Worker stdin stdout ph)
|
||||
start =
|
||||
do
|
||||
(Just i, Just o, _, p) <- createProcess pSpec
|
||||
pure (Worker i o p)
|
||||
where
|
||||
pSpec =
|
||||
(proc "urbit-worker" []) { std_in = CreatePipe
|
||||
, std_out = CreatePipe
|
||||
}
|
||||
|
||||
kill :: Worker -> IO ExitCode
|
||||
kill w = do
|
||||
@ -49,9 +54,6 @@ work id (Jam a) = jam $ toNoun (Cord "work", id, a)
|
||||
newtype Job = Job Void
|
||||
deriving newtype (Eq, Show, ToNoun, FromNoun)
|
||||
|
||||
newtype Tank = Tank Void
|
||||
deriving newtype (Eq, Show, ToNoun, FromNoun)
|
||||
|
||||
type EventId = Word64
|
||||
|
||||
newtype Ship = Ship Word64 -- @p
|
||||
@ -219,15 +221,6 @@ computeThread w = start
|
||||
-- response <- recvAtom w
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
-- Basic Send and Receive Operations -------------------------------------------
|
||||
|
||||
sendAtom :: Worker -> Atom -> IO ()
|
||||
|
Loading…
Reference in New Issue
Block a user