mirror of
https://github.com/ilyakooo0/urbit.git
synced 2024-11-13 08:38:43 +03:00
Merge branch 'king-haskell' of https://github.com/urbit/urbit into philip/king-replay
This commit is contained in:
Benjamin Summers
commit
05e64cfdf0
@ -5,7 +5,7 @@
|
||||
stack2nix-output-path ? "custom-stack2nix-output.nix",
|
||||
}:
|
||||
let
|
||||
cabalPackageName = "king";
|
||||
cabalPackageName = "urbit-king";
|
||||
compiler = "ghc865"; # matching stack.yaml
|
||||
|
||||
# Pin static-haskell-nix version.
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
{-|
|
||||
King Haskell Entry Point
|
||||
|
||||
@ -57,54 +55,41 @@ module Urbit.King.Main (main) where
|
||||
|
||||
import Urbit.Prelude
|
||||
|
||||
import Data.Acquire
|
||||
import Data.Conduit
|
||||
import Data.Conduit.List hiding (catMaybes, map, replicate, take)
|
||||
import Data.RAcquire
|
||||
import Network.HTTP.Client.TLS
|
||||
import RIO.Directory
|
||||
|
||||
import Urbit.Arvo
|
||||
import Urbit.King.Config
|
||||
import Urbit.Noun hiding (Parser)
|
||||
import Urbit.Noun.Conversions (cordToUW)
|
||||
import Urbit.Vere.Dawn
|
||||
import Urbit.Vere.Pier
|
||||
import Urbit.Vere.Pier.Types
|
||||
import Urbit.Vere.Serf
|
||||
|
||||
import Control.Concurrent (myThreadId, runInBoundThread)
|
||||
import Control.Concurrent (myThreadId)
|
||||
import Control.Exception (AsyncException(UserInterrupt))
|
||||
import Control.Lens ((&))
|
||||
import Data.Default (def)
|
||||
import RIO (logSticky, logStickyDone)
|
||||
import System.Process (system)
|
||||
import Text.Show.Pretty (pPrint)
|
||||
import Urbit.King.App (runApp, runAppLogFile, runPierApp)
|
||||
import Urbit.King.App (HasConfigDir(..))
|
||||
import Urbit.King.App (runApp, runAppLogFile, runPierApp)
|
||||
import Urbit.King.App (HasConfigDir(..))
|
||||
import Urbit.Noun.Conversions (cordToUW)
|
||||
import Urbit.Time (Wen)
|
||||
import Urbit.Vere.LockFile (lockFile)
|
||||
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Client as C
|
||||
import qualified System.Console.Terminal.Size as TSize
|
||||
import qualified System.Environment as Sys
|
||||
import qualified System.Exit as Sys
|
||||
import qualified System.IO.LockFile.Internal as Lock
|
||||
import qualified System.Posix.Signals as Sys
|
||||
import qualified System.ProgressBar as PB
|
||||
import qualified System.Random as Sys
|
||||
import qualified Urbit.King.CLI as CLI
|
||||
import qualified Urbit.King.EventBrowser as EventBrowser
|
||||
import qualified Urbit.Ob as Ob
|
||||
import qualified Urbit.Vere.Log as Log
|
||||
import qualified Urbit.Vere.Pier as Pier
|
||||
import qualified Urbit.Vere.Serf as Serf
|
||||
import qualified Urbit.Vere.Term as Term
|
||||
import qualified Data.Set as Set
|
||||
import qualified Data.Text as T
|
||||
import qualified Network.HTTP.Client as C
|
||||
import qualified System.Environment as Sys
|
||||
import qualified System.Posix.Signals as Sys
|
||||
import qualified System.ProgressBar as PB
|
||||
import qualified System.Random as Sys
|
||||
import qualified Urbit.King.CLI as CLI
|
||||
import qualified Urbit.King.EventBrowser as EventBrowser
|
||||
import qualified Urbit.Ob as Ob
|
||||
import qualified Urbit.Vere.Log as Log
|
||||
import qualified Urbit.Vere.Pier as Pier
|
||||
import qualified Urbit.Vere.Serf as Serf
|
||||
import qualified Urbit.Vere.Term as Term
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
@ -216,10 +201,6 @@ tryPlayShip exitImmediately fullReplay playFrom flags = do
|
||||
rio $ logTrace "SHIP RESUMED"
|
||||
pure sls
|
||||
|
||||
runAcquire :: (MonadUnliftIO m, MonadIO m)
|
||||
=> Acquire a -> m a
|
||||
runAcquire act = with act pure
|
||||
|
||||
runRAcquire :: (MonadUnliftIO (m e), MonadIO (m e), MonadReader e (m e))
|
||||
=> RAcquire e a -> m e a
|
||||
runRAcquire act = rwith act pure
|
||||
@ -307,7 +288,6 @@ replayPartEvs top last = do
|
||||
case snap of
|
||||
Nothing -> pure ()
|
||||
Just sn -> do
|
||||
let start = top <> "/.partial-replay/"
|
||||
liftIO $ system $ "cp -r \"" <> sn <> "\" \"" <> tmpDir <> "\""
|
||||
pure ()
|
||||
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
{-|
|
||||
Large Library of conversion between various types and Nouns.
|
||||
-}
|
||||
@ -34,17 +32,13 @@ import GHC.Natural (Natural)
|
||||
import GHC.Types (Char(C#))
|
||||
import GHC.Word (Word32(W32#))
|
||||
import Prelude ((!!))
|
||||
import RIO (decodeUtf8Lenient)
|
||||
import RIO.FilePath (joinPath, splitDirectories, takeBaseName,
|
||||
takeDirectory, takeExtension, (<.>), (</>))
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Text.Show.Pretty (ppShow)
|
||||
takeDirectory, takeExtension, (<.>))
|
||||
import Urbit.Noun.Cue (cue)
|
||||
import Urbit.Noun.Jam (jam)
|
||||
|
||||
import qualified Data.Char as C
|
||||
import qualified Data.Text.Encoding as T
|
||||
import qualified Data.Text.Encoding.Error as T
|
||||
|
||||
|
||||
-- Noun ------------------------------------------------------------------------
|
||||
@ -366,13 +360,12 @@ instance FromNoun a => FromNoun (Lenient a) where
|
||||
fromNounErr n & \case
|
||||
Right x -> pure (GoodParse x)
|
||||
Left err -> do
|
||||
traceM ("LENIENT.FromNoun: " <> show err)
|
||||
traceM (ppShow n)
|
||||
-- traceM ("LENIENT.FromNoun: " <> show err)
|
||||
-- traceM (ppShow n)
|
||||
pure (FailParse n)
|
||||
|
||||
instance ToNoun a => ToNoun (Lenient a) where
|
||||
toNoun (FailParse n) = trace ("LENIENT.ToNoun: " <> show n)
|
||||
n
|
||||
toNoun (FailParse n) = n -- trace ("LENIENT.ToNoun: " <> show n)
|
||||
toNoun (GoodParse x) = toNoun x
|
||||
|
||||
|
||||
@ -388,9 +381,8 @@ instance FromNoun a => FromNoun (Todo a) where
|
||||
parseNoun n = do
|
||||
fromNounErr n & \case
|
||||
Right x -> pure (Todo x)
|
||||
Left er -> do
|
||||
traceM ("[TODO]: " <> show er <> "\n" <> ppShow n <> "\n")
|
||||
fail (show er)
|
||||
Left er -> fail (show er)
|
||||
-- traceM ("[TODO]: " <> show er <> "\n" <> ppShow n <> "\n")
|
||||
|
||||
|
||||
-- Nullable --------------------------------------------------------------------
|
||||
|
||||
@ -22,8 +22,6 @@
|
||||
"hosed";
|
||||
-}
|
||||
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
module Urbit.Vere.Http.Server where
|
||||
|
||||
import Data.Conduit
|
||||
@ -416,8 +414,11 @@ openPort isFake = go
|
||||
|
||||
bindListenPort ∷ W.Port → Net.Socket → IO Net.PortNumber
|
||||
bindListenPort por sok = do
|
||||
bindAddr <- Net.inet_addr bindTo
|
||||
Net.bind sok (Net.SockAddrInet (fromIntegral por) bindAddr)
|
||||
bindAddr <- Net.getAddrInfo Nothing (Just bindTo) Nothing >>= \case
|
||||
[] -> error "this should never happen."
|
||||
x:_ -> pure (Net.addrAddress x)
|
||||
|
||||
Net.bind sok bindAddr
|
||||
Net.listen sok 1
|
||||
Net.socketPort sok
|
||||
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
{-|
|
||||
Top-Level Pier Management
|
||||
|
||||
@ -19,7 +17,6 @@ import Urbit.King.Config
|
||||
import Urbit.Vere.Pier.Types
|
||||
import Control.Monad.Trans.Maybe
|
||||
|
||||
import Data.List (uncons)
|
||||
import Data.Text (append)
|
||||
import System.Posix.Files (ownerModes, setFileMode)
|
||||
import Urbit.King.App (HasConfigDir(..))
|
||||
|
||||
@ -1,5 +1,3 @@
|
||||
{-# OPTIONS_GHC -Wwarn #-}
|
||||
|
||||
{-|
|
||||
Serf Interface
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user