diff --git a/pkg/hs-urbit/.gitignore b/pkg/king/.gitignore similarity index 100% rename from pkg/hs-urbit/.gitignore rename to pkg/king/.gitignore diff --git a/pkg/king/app/CLI.hs b/pkg/king/app/CLI.hs new file mode 100644 index 0000000000..243a8c3994 --- /dev/null +++ b/pkg/king/app/CLI.hs @@ -0,0 +1,133 @@ +{-# OPTIONS_GHC -Werror -Wall #-} +{-# LANGUAGE CPP #-} + +module CLI (parseArgs, Cmd(..), New(..), Run(..), Opts(..)) where + +import ClassyPrelude +import Options.Applicative +import Options.Applicative.Help.Pretty + +import Data.Word (Word16) +import System.Environment (getProgName) + +-------------------------------------------------------------------------------- + +data Opts = Opts + { oQuiet :: Bool + , oHashless :: Bool + , oExit :: Bool + , oVerbose :: Bool + , oAmesPort :: Maybe Word16 + , oProf :: Bool + } + deriving (Show) + +data New = New + { naPillPath :: FilePath + , naShipAddr :: Text + , naPierPath :: FilePath + , naArvoDir :: Maybe FilePath + } + deriving (Show) + +data Run = Run + { raPierPath :: FilePath + } + deriving (Show) + +data Cmd + = CmdNew New Opts + | CmdRun Run Opts + deriving (Show) + +-------------------------------------------------------------------------------- + +headNote :: String -> Doc +headNote _version = string $ intercalate "\n" + [ "Urbit: a personal server operating function" + , "https://urbit.org" + , "Version " <> VERSION_king + ] + +footNote :: String -> Doc +footNote exe = string $ intercalate "\n" + [ "Development Usage:" + , " To create a development ship, use a fakezod:" + , " $ " <>exe<> " new zod /path/to/pill -F zod -A arvo/folder" + , "" + , "Simple Usage: " + , " $ " <>exe<> " new pier to create a comet (anonymous urbit)" + , " $ " <>exe<> " new pier -k if you own a planet" + , " $ " <>exe<> " run to restart an existing urbit" + , "" + , "For more information about developing on urbit, see:" + , " https://github.com/urbit/urbit/blob/master/CONTRIBUTING.md" + ] + +-------------------------------------------------------------------------------- + +parseArgs :: IO Cmd +parseArgs = do + nm <- getProgName + + let p = prefs $ showHelpOnError + <> showHelpOnEmpty + <> columns 80 + + let o = info (cmd <**> helper) + $ progDesc "Start an existing Urbit or boot a new one." + <> headerDoc (Just $ headNote "0.9001.0") + <> footerDoc (Just $ footNote nm) + <> fullDesc + + customExecParser p o + +-------------------------------------------------------------------------------- + +run :: Parser Run +run = do + raPierPath <- strArgument (metavar "PIER" <> help "Path to pier") + pure Run{..} + +new :: Parser New +new = do + naPierPath <- strArgument (metavar "PIER" <> help "Path to pier") + + naPillPath <- strArgument $ metavar "PILL" + <> help "Path to pill file" + + naShipAddr <- strArgument $ metavar "SHIP" + <> help "Ship address" + + naArvoDir <- option auto $ metavar "ARVO" + <> short 'A' + <> value Nothing + <> help "Initial Arvo filesystem" + + pure New{..} + +opts :: Parser Opts +opts = do + oAmesPort <- option auto $ metavar "PORT" + <> short 'p' + <> help "Ames port number" + <> value Nothing + + oHashless <- switch (short 'S' <> help "Disable battery hashing") + oQuiet <- switch (short 'q' <> help "Quiet") + oVerbose <- switch (short 'v' <> help "Verbose") + oExit <- switch (short 'x' <> help "Exit immediatly") + oProf <- switch (short 'p' <> help "Enable profiling") + + pure (Opts{..}) + +cmd :: Parser Cmd +cmd = subparser + ( (command "new" $ info (newShip <**> helper) + $ progDesc "Boot a new ship") + <> (command "run" $ info (runShip <**> helper) + $ progDesc "Run an existing ship") + ) + where + runShip = CmdRun <$> run <*> opts + newShip = CmdNew <$> new <*> opts diff --git a/pkg/hs-vere/app/test/Main.hs b/pkg/king/app/Main.hs similarity index 96% rename from pkg/hs-vere/app/test/Main.hs rename to pkg/king/app/Main.hs index 6ca664f2d0..c6b962c8d3 100644 --- a/pkg/hs-vere/app/test/Main.hs +++ b/pkg/king/app/Main.hs @@ -2,12 +2,15 @@ module Main where import ClassyPrelude +import Options.Applicative +import Options.Applicative.Help.Pretty + import Arvo import Control.Exception hiding (evaluate) import Data.Acquire import Data.Conduit -import Data.Conduit.List -import Noun +import Data.Conduit.List hiding (replicate) +import Noun hiding (Parser) import Vere.Pier import Vere.Pier.Types import Vere.Serf @@ -15,9 +18,11 @@ import Vere.Serf import Control.Concurrent (runInBoundThread, threadDelay) import Control.Lens ((&)) import System.Directory (doesFileExist, removeFile) +import System.Environment (getProgName) import Text.Show.Pretty (pPrint) import Urbit.Time (Wen) +import qualified CLI import qualified Data.Set as Set import qualified Vere.Log as Log import qualified Vere.Pier as Pier @@ -153,8 +158,8 @@ collectAllFx top = do -------------------------------------------------------------------------------- -main :: IO () -main = runInBoundThread $ do +tryDoStuff :: IO () +tryDoStuff = runInBoundThread $ do let pillPath = "/home/benjamin/r/urbit/bin/solid.pill" shipPath = "/home/benjamin/r/urbit/s/dev/" ship = zod @@ -174,6 +179,9 @@ main = runInBoundThread $ do pure () +main :: IO () +main = CLI.parseArgs >>= print + -------------------------------------------------------------------------------- tryParseFX :: FilePath -> Word -> Word -> IO () diff --git a/pkg/hs-vere/app/uterm/Main.hs b/pkg/king/app/TryJamPill.hs similarity index 98% rename from pkg/hs-vere/app/uterm/Main.hs rename to pkg/king/app/TryJamPill.hs index ec12f6ed19..480a9fef8e 100644 --- a/pkg/hs-vere/app/uterm/Main.hs +++ b/pkg/king/app/TryJamPill.hs @@ -1,4 +1,4 @@ -module Main where +module TryJamPill where import ClassyPrelude import Control.Lens diff --git a/pkg/hs-vere/app/vere/Main.hs b/pkg/king/app/TryTimers.hs similarity index 97% rename from pkg/hs-vere/app/vere/Main.hs rename to pkg/king/app/TryTimers.hs index 0e55739093..b732bb541d 100644 --- a/pkg/hs-vere/app/vere/Main.hs +++ b/pkg/king/app/TryTimers.hs @@ -1,5 +1,6 @@ -module Main where +module TryTimers where +{- import Prelude import Control.Lens @@ -47,3 +48,4 @@ main = do putStrLn "" replicateM_ 10 (bench behn) putStrLn "" +-} diff --git a/pkg/hs-urbit/lib/Arvo.hs b/pkg/king/lib/Arvo.hs similarity index 100% rename from pkg/hs-urbit/lib/Arvo.hs rename to pkg/king/lib/Arvo.hs diff --git a/pkg/hs-urbit/lib/Arvo/Common.hs b/pkg/king/lib/Arvo/Common.hs similarity index 100% rename from pkg/hs-urbit/lib/Arvo/Common.hs rename to pkg/king/lib/Arvo/Common.hs diff --git a/pkg/hs-urbit/lib/Arvo/Effect.hs b/pkg/king/lib/Arvo/Effect.hs similarity index 100% rename from pkg/hs-urbit/lib/Arvo/Effect.hs rename to pkg/king/lib/Arvo/Effect.hs diff --git a/pkg/hs-urbit/lib/Arvo/Event.hs b/pkg/king/lib/Arvo/Event.hs similarity index 100% rename from pkg/hs-urbit/lib/Arvo/Event.hs rename to pkg/king/lib/Arvo/Event.hs diff --git a/pkg/hs-urbit/lib/Noun.hs b/pkg/king/lib/Noun.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun.hs rename to pkg/king/lib/Noun.hs diff --git a/pkg/hs-urbit/lib/Noun/Atom.hs b/pkg/king/lib/Noun/Atom.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Atom.hs rename to pkg/king/lib/Noun/Atom.hs diff --git a/pkg/hs-urbit/lib/Noun/Conversions.hs b/pkg/king/lib/Noun/Conversions.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Conversions.hs rename to pkg/king/lib/Noun/Conversions.hs diff --git a/pkg/hs-urbit/lib/Noun/Convert.hs b/pkg/king/lib/Noun/Convert.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Convert.hs rename to pkg/king/lib/Noun/Convert.hs diff --git a/pkg/hs-urbit/lib/Noun/Core.hs b/pkg/king/lib/Noun/Core.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Core.hs rename to pkg/king/lib/Noun/Core.hs diff --git a/pkg/hs-urbit/lib/Noun/Cue.hs b/pkg/king/lib/Noun/Cue.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Cue.hs rename to pkg/king/lib/Noun/Cue.hs diff --git a/pkg/hs-urbit/lib/Noun/Jam.hs b/pkg/king/lib/Noun/Jam.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Jam.hs rename to pkg/king/lib/Noun/Jam.hs diff --git a/pkg/hs-urbit/lib/Noun/Lens.hs b/pkg/king/lib/Noun/Lens.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Lens.hs rename to pkg/king/lib/Noun/Lens.hs diff --git a/pkg/hs-urbit/lib/Noun/TH.hs b/pkg/king/lib/Noun/TH.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/TH.hs rename to pkg/king/lib/Noun/TH.hs diff --git a/pkg/hs-urbit/lib/Noun/Tank.hs b/pkg/king/lib/Noun/Tank.hs similarity index 100% rename from pkg/hs-urbit/lib/Noun/Tank.hs rename to pkg/king/lib/Noun/Tank.hs diff --git a/pkg/hs-urbit/lib/Urbit/CTTP.hs b/pkg/king/lib/Urbit/CTTP.hs similarity index 100% rename from pkg/hs-urbit/lib/Urbit/CTTP.hs rename to pkg/king/lib/Urbit/CTTP.hs diff --git a/pkg/hs-urbit/lib/Urbit/Time.hs b/pkg/king/lib/Urbit/Time.hs similarity index 100% rename from pkg/hs-urbit/lib/Urbit/Time.hs rename to pkg/king/lib/Urbit/Time.hs diff --git a/pkg/hs-urbit/lib/Urbit/Timer.hs b/pkg/king/lib/Urbit/Timer.hs similarity index 100% rename from pkg/hs-urbit/lib/Urbit/Timer.hs rename to pkg/king/lib/Urbit/Timer.hs diff --git a/pkg/hs-urbit/lib/UrbitPrelude.hs b/pkg/king/lib/UrbitPrelude.hs similarity index 100% rename from pkg/hs-urbit/lib/UrbitPrelude.hs rename to pkg/king/lib/UrbitPrelude.hs diff --git a/pkg/hs-urbit/lib/Vere/Ames.hs b/pkg/king/lib/Vere/Ames.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Ames.hs rename to pkg/king/lib/Vere/Ames.hs diff --git a/pkg/hs-urbit/lib/Vere/Behn.hs b/pkg/king/lib/Vere/Behn.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Behn.hs rename to pkg/king/lib/Vere/Behn.hs diff --git a/pkg/hs-urbit/lib/Vere/Http.hs b/pkg/king/lib/Vere/Http.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Http.hs rename to pkg/king/lib/Vere/Http.hs diff --git a/pkg/hs-urbit/lib/Vere/Http/Client.hs b/pkg/king/lib/Vere/Http/Client.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Http/Client.hs rename to pkg/king/lib/Vere/Http/Client.hs diff --git a/pkg/hs-urbit/lib/Vere/Http/Server.hs b/pkg/king/lib/Vere/Http/Server.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Http/Server.hs rename to pkg/king/lib/Vere/Http/Server.hs diff --git a/pkg/hs-urbit/lib/Vere/Isle.hs b/pkg/king/lib/Vere/Isle.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Isle.hs rename to pkg/king/lib/Vere/Isle.hs diff --git a/pkg/hs-urbit/lib/Vere/Isle/Util.hs b/pkg/king/lib/Vere/Isle/Util.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Isle/Util.hs rename to pkg/king/lib/Vere/Isle/Util.hs diff --git a/pkg/hs-urbit/lib/Vere/Log.hs b/pkg/king/lib/Vere/Log.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Log.hs rename to pkg/king/lib/Vere/Log.hs diff --git a/pkg/hs-urbit/lib/Vere/Pier.hs b/pkg/king/lib/Vere/Pier.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Pier.hs rename to pkg/king/lib/Vere/Pier.hs diff --git a/pkg/hs-urbit/lib/Vere/Pier/Types.hs b/pkg/king/lib/Vere/Pier/Types.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Pier/Types.hs rename to pkg/king/lib/Vere/Pier/Types.hs diff --git a/pkg/hs-urbit/lib/Vere/Serf.hs b/pkg/king/lib/Vere/Serf.hs similarity index 100% rename from pkg/hs-urbit/lib/Vere/Serf.hs rename to pkg/king/lib/Vere/Serf.hs diff --git a/pkg/hs-urbit/package.yaml b/pkg/king/package.yaml similarity index 87% rename from pkg/hs-urbit/package.yaml rename to pkg/king/package.yaml index e9814407f3..d229ae1de0 100644 --- a/pkg/hs-urbit/package.yaml +++ b/pkg/king/package.yaml @@ -1,4 +1,4 @@ -name: urbit +name: king version: 0.1.0 license: AGPL-3.0-only @@ -12,10 +12,10 @@ library: - -O2 tests: - urbit-tests: + king-tests: source-dirs: test main: Main.hs - dependencies: urbit + dependencies: king ghc-options: - -threaded - -rtsopts @@ -82,6 +82,7 @@ dependencies: - wai-conduit - warp - warp-tls + - optparse-applicative default-extensions: - ApplicativeDo @@ -127,3 +128,15 @@ default-extensions: - UnboxedTuples - UnicodeSyntax - ViewPatterns + +executables: + king: + main: Main.hs + source-dirs: app + dependencies: ["king"] + ghc-options: + - -threaded + - -rtsopts + - "-with-rtsopts=-N" + - -fwarn-incomplete-patterns + - -O0 diff --git a/pkg/hs-urbit/test/AmesTests.hs b/pkg/king/test/AmesTests.hs similarity index 100% rename from pkg/hs-urbit/test/AmesTests.hs rename to pkg/king/test/AmesTests.hs diff --git a/pkg/hs-urbit/test/ArvoTests.hs b/pkg/king/test/ArvoTests.hs similarity index 100% rename from pkg/hs-urbit/test/ArvoTests.hs rename to pkg/king/test/ArvoTests.hs diff --git a/pkg/hs-urbit/test/BehnTests.hs b/pkg/king/test/BehnTests.hs similarity index 100% rename from pkg/hs-urbit/test/BehnTests.hs rename to pkg/king/test/BehnTests.hs diff --git a/pkg/hs-urbit/test/DeriveNounTests.hs b/pkg/king/test/DeriveNounTests.hs similarity index 100% rename from pkg/hs-urbit/test/DeriveNounTests.hs rename to pkg/king/test/DeriveNounTests.hs diff --git a/pkg/hs-urbit/test/LogTests.hs b/pkg/king/test/LogTests.hs similarity index 100% rename from pkg/hs-urbit/test/LogTests.hs rename to pkg/king/test/LogTests.hs diff --git a/pkg/hs-urbit/test/Main.hs b/pkg/king/test/Main.hs similarity index 100% rename from pkg/hs-urbit/test/Main.hs rename to pkg/king/test/Main.hs diff --git a/stack.yaml b/stack.yaml index 24c0da6d12..fc62ab377a 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,8 +1,7 @@ resolver: lts-13.10 packages: - - pkg/hs-urbit - - pkg/hs-vere + - pkg/king extra-deps: - para-1.1@sha256:a90eebb063ad70271e6e2a7f00a93e8e8f8b77273f100f39852fbf8301926f81 @@ -17,7 +16,7 @@ nix: - zlib ghc-options: - urbit: -fobject-code + king: -fobject-code # build: # executable-profiling: true