king: Spin off urbit-noun-core and urbit-noun packages.

pkg/hs/stack.yaml

@@ -7,6 +7,8 @@ packages:
   - urbit-atom
   - urbit-azimuth
   - urbit-king
+  - urbit-noun
+  - urbit-noun-core
 
 extra-deps:
   - flat-0.3.4@sha256:002a0e0ae656ea8cc02a772d0bcb6ea7dbd7f2e79070959cc748ad1e7138eb38

pkg/hs/urbit-king/TODO.md

@@ -60,7 +60,7 @@ Polish:
 - [ ] Simplify `Main.hs` flows.
 - [ ] Cleanup Terminal Driver code.
 - [ ] Spin off `RAcquire` into it's own package.
-- [ ] Spin off `Urbit.Noun` into it's own package.
+- [x] Spin off `urbit-noun-core` and `urbit-noun` packages.
 - [ ] Spin off `Urbit.Vere.Log` into it's own package.
 - [ ] Spin off `Urbit.Vere.Serf` into it's own package, and make it care
       less about the shape of events and effects.

pkg/hs/urbit-king/lib/Urbit/Arvo/Effect.hs

@@ -3,8 +3,8 @@
 -}
 module Urbit.Arvo.Effect where
 
+import Urbit.Noun.Time
 import Urbit.Prelude
-import Urbit.Time
 
 import Urbit.Arvo.Common (KingId(..), ServId(..))
 import Urbit.Arvo.Common (Header, HttpEvent, HttpServerConf, Method, Mime)

pkg/hs/urbit-king/lib/Urbit/King/EventBrowser.hs

@@ -10,7 +10,7 @@ import Urbit.Prelude
 
 import Data.Conduit
 import Urbit.Arvo
-import Urbit.Time
+import Urbit.Noun.Time
 import Urbit.Vere.Pier.Types
 
 import Control.Monad.Trans.Maybe (MaybeT(..))

pkg/hs/urbit-king/lib/Urbit/King/Main.hs

@@ -96,7 +96,7 @@ import Urbit.King.App         (killKingActionL, onKillKingSigL)
 import Urbit.King.App         (killPierActionL)
 import Urbit.King.App         (runKingEnvLogFile, runKingEnvStderr, runPierEnv)
 import Urbit.Noun.Conversions (cordToUW)
-import Urbit.Time             (Wen)
+import Urbit.Noun.Time        (Wen)
 import Urbit.Vere.LockFile    (lockFile)
 
 import qualified Data.Set                as Set

pkg/hs/urbit-king/lib/Urbit/Vere/Ames/DNS.hs

@@ -64,9 +64,9 @@ import Urbit.Prelude
 import Network.Socket        hiding (recvFrom, sendTo)
 import Urbit.Arvo            hiding (Fake)
 
-import qualified Data.Map   as M
-import qualified Urbit.Ob   as Ob
-import qualified Urbit.Time as Time
+import qualified Data.Map        as M
+import qualified Urbit.Noun.Time as Time
+import qualified Urbit.Ob        as Ob
 
 
 -- Types -----------------------------------------------------------------------

pkg/hs/urbit-king/lib/Urbit/Vere/Behn.hs

@@ -8,12 +8,12 @@ import Urbit.Arvo            hiding (Behn)
 import Urbit.Prelude
 import Urbit.Vere.Pier.Types
 
-import Urbit.King.App (HasPierEnv(..), HasKingId(..))
-import Urbit.Time     (Wen)
-import Urbit.Timer    (Timer)
+import Urbit.King.App  (HasKingId(..), HasPierEnv(..))
+import Urbit.Noun.Time (Wen)
+import Urbit.Timer     (Timer)
 
-import qualified Urbit.Time  as Time
-import qualified Urbit.Timer as Timer
+import qualified Urbit.Noun.Time as Time
+import qualified Urbit.Timer     as Timer
 
 
 -- Behn Stuff ------------------------------------------------------------------

pkg/hs/urbit-king/lib/Urbit/Vere/Pier.hs

@@ -28,7 +28,7 @@ import Data.Text              (append)
 import System.Posix.Files     (ownerModes, setFileMode)
 import Urbit.King.App         (HasKingEnv, HasPierEnv(..), PierEnv)
 import Urbit.King.App         (onKillPierSigL)
-import Urbit.Time             (Wen)
+import Urbit.Noun.Time        (Wen)
 import Urbit.Vere.Ames        (ames)
 import Urbit.Vere.Behn        (behn)
 import Urbit.Vere.Clay        (clay)
@@ -40,7 +40,7 @@ import Urbit.Vere.Serf        (Serf)
 
 import qualified System.Entropy         as Ent
 import qualified Urbit.King.API         as King
-import qualified Urbit.Time             as Time
+import qualified Urbit.Noun.Time        as Time
 import qualified Urbit.Vere.Log         as Log
 import qualified Urbit.Vere.Serf        as Serf
 import qualified Urbit.Vere.Term        as Term

pkg/hs/urbit-king/lib/Urbit/Vere/Pier/Types.hs

@@ -20,7 +20,7 @@ where
 import Urbit.Prelude hiding (Term)
 
 import Urbit.Arvo
-import Urbit.Time
+import Urbit.Noun.Time
 
 import Urbit.Vere.Serf.Types
 

pkg/hs/urbit-king/lib/Urbit/Vere/Serf/IPC.hs

@@ -79,12 +79,12 @@ import Foreign.Storable             (peek, poke)
 import RIO.Prelude                  (decodeUtf8Lenient)
 import System.Posix.Signals         (sigKILL, signalProcess)
 import Urbit.Arvo                   (Ev, FX)
-import Urbit.Time                   (Wen)
+import Urbit.Noun.Time              (Wen)
 
 import qualified Data.ByteString        as BS
 import qualified Data.ByteString.Unsafe as BS
 import qualified System.IO.Error        as IO
-import qualified Urbit.Time             as Time
+import qualified Urbit.Noun.Time        as Time
 
 
 -- Serf API --------------------------------------------------------------------

pkg/hs/urbit-king/lib/Urbit/Vere/Serf/Types.hs

@@ -2,8 +2,8 @@ module Urbit.Vere.Serf.Types where
 
 import Urbit.Prelude
 
-import Urbit.Arvo (Ev, FX)
-import Urbit.Time (Wen)
+import Urbit.Arvo      (Ev, FX)
+import Urbit.Noun.Time (Wen)
 
 
 -- Types -----------------------------------------------------------------------

pkg/hs/urbit-king/lib/Urbit/Vere/Term.hs

@@ -18,8 +18,8 @@ import RIO.FilePath
 import System.Posix.IO
 import System.Posix.Terminal
 import Urbit.Arvo            hiding (Term)
+import Urbit.Noun.Time
 import Urbit.Prelude         hiding (getCurrentTime)
-import Urbit.Time
 import Urbit.Vere.Pier.Types
 
 import Data.List           ((!!))

pkg/hs/urbit-king/package.yaml

@@ -99,6 +99,8 @@ dependencies:
   - unliftio-core
   - unordered-containers
   - urbit-atom
+  - urbit-noun
+  - urbit-noun-core
   - urbit-azimuth
   - urbit-hob
   - utf8-string

pkg/hs/urbit-king/test/AmesTests.hs

@@ -10,8 +10,8 @@ import Test.Tasty.TH
 import Urbit.Arvo
 import Urbit.King.Config
 import Urbit.Noun
+import Urbit.Noun.Time
 import Urbit.Prelude
-import Urbit.Time
 import Urbit.Vere.Ames
 import Urbit.Vere.Log
 import Urbit.Vere.Pier.Types
@@ -73,36 +73,38 @@ runNetworkApp = runRIO NetworkTestApp
   }
 
 runGala
-  :: forall e . HasAmes e => Word8 -> RAcquire e (TQueue EvErr, EffCb e NewtEf)
+  :: forall e
+   . HasAmes e
+  => Word8
+  -> RAcquire e (TQueue EvErr, NewtEf -> IO ())
 runGala point = do
     env <- ask
     que <- newTQueueIO
     let (_, runAmes) =
           ames env (fromIntegral point) True (writeTQueue que) noStderr
     cb <- runAmes
-    rio $ cb turfEf
+    io (cb turfEf)
     pure (que, cb)
   where
     noStderr _ = pure ()
 
 waitForPacket :: TQueue EvErr -> Bytes -> IO Bool
 waitForPacket q val = go
-  where
-    go =
-      atomically (readTQueue q) >>= \case
-        EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go
-        EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _    -> pure (bs == val)
-        _                                                     -> pure False
+ where
+  go = atomically (readTQueue q) >>= \case
+    EvErr (EvBlip (BlipEvNewt (NewtEvBorn (_, ()) ()))) _ -> go
+    EvErr (EvBlip (BlipEvAmes (AmesEvHear () _ bs))) _ -> pure (bs == val)
+    _ -> pure False
 
 runRAcquire :: RAcquire e a -> RIO e a
 runRAcquire acq = rwith acq pure
 
-sendThread :: EffCb e NewtEf -> (Galaxy, Bytes) -> RAcquire e ()
+sendThread :: (NewtEf -> IO ()) -> (Galaxy, Bytes) -> RAcquire e ()
 sendThread cb (to, val) = void $ mkRAcquire start cancel
   where
     start = async $ forever $ do threadDelay 1_000
                                  wen <- io $ now
-                                 cb (sendEf to wen val)
+                                 io $ cb (sendEf to wen val)
                                  threadDelay 10_000
 
 zodSelfMsg :: Property

pkg/hs/urbit-king/test/ArvoTests.hs

@@ -10,8 +10,8 @@ import Test.Tasty
 import Test.Tasty.QuickCheck
 import Test.Tasty.TH
 import Urbit.Arvo
+import Urbit.Noun.Time
 import Urbit.Prelude
-import Urbit.Time
 import Urbit.Vere.Log
 import Urbit.Vere.Pier.Types
 

pkg/hs/urbit-king/test/BehnTests.hs

@@ -10,8 +10,8 @@ import Test.Tasty.QuickCheck
 import Test.Tasty.TH
 import Urbit.Arvo
 import Urbit.Noun
+import Urbit.Noun.Time
 import Urbit.Prelude
-import Urbit.Time
 import Urbit.Vere.Behn
 import Urbit.Vere.Log
 import Urbit.Vere.Pier.Types
@@ -22,8 +22,8 @@ import GHC.Natural        (Natural)
 import Network.Socket     (tupleToHostAddress)
 import Urbit.King.App     (runKingEnvNoLog, HasKingId(..))
 
-import qualified Urbit.Time     as Time
-import qualified Urbit.Vere.Log as Log
+import qualified Urbit.Noun.Time as Time
+import qualified Urbit.Vere.Log  as Log
 
 
 --------------------------------------------------------------------------------
@@ -38,7 +38,7 @@ timerFires = forAll arbitrary (ioProperty . runKingEnvNoLog . runTest)
       king <- fromIntegral <$> view kingIdL
       q <- newTQueueIO
       rwith (liftAcquire $ snd $ behn envr (writeTQueue q)) $ \cb -> do
-        cb (BehnEfDoze (king, ()) (Just (2^20)))
+        io $ cb (BehnEfDoze (king, ()) (Just (2^20)))
         t <- atomically $ readTQueue q
         pure True
 

pkg/hs/urbit-noun-core/.gitignore

@@ -0,0 +1,3 @@
+.stack-work
+*.cabal
+test/gold/*.writ

pkg/hs/urbit-noun-core/LICENSE

@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2016 urbit
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

pkg/hs/urbit-noun-core/package.yaml

@@ -0,0 +1,71 @@
+name: urbit-noun-core
+version: 0.10.4
+license: MIT
+license-file: LICENSE
+
+library:
+  source-dirs: lib
+  ghc-options:
+    - -fwarn-incomplete-patterns
+    - -fwarn-unused-binds
+    - -fwarn-unused-imports
+    - -Werror
+    - -O2
+
+dependencies:
+  - base
+  - QuickCheck
+  - ghc-prim
+  - hashable
+  - urbit-atom
+  - classy-prelude
+  - bytestring
+  - hashtables
+  - vector
+  - integer-gmp
+  - template-haskell
+
+default-extensions:
+  - ApplicativeDo
+  - BangPatterns
+  - BlockArguments
+  - ConstraintKinds
+  - DataKinds
+  - DefaultSignatures
+  - DeriveAnyClass
+  - DeriveDataTypeable
+  - DeriveFoldable
+  - DeriveGeneric
+  - DeriveTraversable
+  - DerivingStrategies
+  - EmptyCase
+  - EmptyDataDecls
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - GADTs
+  - GeneralizedNewtypeDeriving
+  - LambdaCase
+  - MagicHash
+  - MultiParamTypeClasses
+  - NamedFieldPuns
+  - NoImplicitPrelude
+  - NumericUnderscores
+  - OverloadedStrings
+  - PackageImports
+  - PartialTypeSignatures
+  - PatternSynonyms
+  - QuasiQuotes
+  - Rank2Types
+  - RankNTypes
+  - RecordWildCards
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TemplateHaskell
+  - TupleSections
+  - TypeApplications
+  - TypeFamilies
+  - TypeOperators
+  - UnboxedTuples
+  - UnicodeSyntax
+  - ViewPatterns

pkg/hs/urbit-noun/.gitignore

@@ -0,0 +1,3 @@
+.stack-work
+*.cabal
+test/gold/*.writ

pkg/hs/urbit-noun/LICENSE

@@ -0,0 +1,21 @@
+The MIT License (MIT)
+
+Copyright (c) 2016 urbit
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

pkg/hs/urbit-noun/lib/Urbit/Noun/Time.hs

@@ -2,7 +2,7 @@
     TODO This is slow.
 -}
 
-module Urbit.Time where
+module Urbit.Noun.Time where
 
 import Control.Lens
 import Prelude

pkg/hs/urbit-noun/package.yaml

@@ -0,0 +1,73 @@
+name: urbit-noun
+version: 0.10.4
+license: MIT
+license-file: LICENSE
+
+library:
+  source-dirs: lib
+  ghc-options:
+    - -fwarn-incomplete-patterns
+    - -fwarn-unused-binds
+    - -fwarn-unused-imports
+    - -Werror
+    - -O2
+
+dependencies:
+  - base
+  - classy-prelude
+  - ghc-prim
+  - largeword
+  - lens
+  - murmur3
+  - regex-tdfa
+  - regex-tdfa-text
+  - rio
+  - text
+  - time
+  - urbit-atom
+  - urbit-noun-core
+
+default-extensions:
+  - ApplicativeDo
+  - BangPatterns
+  - BlockArguments
+  - ConstraintKinds
+  - DataKinds
+  - DefaultSignatures
+  - DeriveAnyClass
+  - DeriveDataTypeable
+  - DeriveFoldable
+  - DeriveGeneric
+  - DeriveTraversable
+  - DerivingStrategies
+  - EmptyCase
+  - EmptyDataDecls
+  - FlexibleContexts
+  - FlexibleInstances
+  - FunctionalDependencies
+  - GADTs
+  - GeneralizedNewtypeDeriving
+  - LambdaCase
+  - MagicHash
+  - MultiParamTypeClasses
+  - NamedFieldPuns
+  - NoImplicitPrelude
+  - NumericUnderscores
+  - OverloadedStrings
+  - PackageImports
+  - PartialTypeSignatures
+  - PatternSynonyms
+  - QuasiQuotes
+  - Rank2Types
+  - RankNTypes
+  - RecordWildCards
+  - ScopedTypeVariables
+  - StandaloneDeriving
+  - TemplateHaskell
+  - TupleSections
+  - TypeApplications
+  - TypeFamilies
+  - TypeOperators
+  - UnboxedTuples
+  - UnicodeSyntax
+  - ViewPatterns