commit 21ce81509047bcf3652841534851ad83af47aa74
parent f9d887c56b669c27203e5394c9ad05736a5ff2d8
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 20 Sep 2019 09:32:23 -0230
co: add patq support
Adds a Patq type, plus analogues of all the patp functions for dealing
with it (patq, fromPatq, renderPatq, parsePatq).
Diffstat:
5 files changed, 220 insertions(+), 69 deletions(-)
diff --git a/README.md b/README.md
@@ -8,22 +8,24 @@ Utilities for phonetic base wrangling.
## What
-Here you can primarily find functions for dealing with the "patp" *phonetic
-base* used by Urbit. The `@p` encoding is used for naming ships; it uniquely
-represents a nonnegative integer (i.e. an *atom*) in a memorable and
-pronounceable fashion.
+Here you can primarily find functions for dealing with the "patp" and "patq"
+*phonetic bases* used by Urbit. The `@p` encoding is used for naming ships,
+whereas the `@q` encoding is used for arbitrary data; they both uniquely
+represent nonnegative integers (i.e. *atoms*) in a memorable and pronounceable
+fashion.
The `@p` encoding is an *obfuscated* representation of an underlying atom, in
particular, hence the 'ob' in the library's name.
## Usage
-The library exposes two functions, `patp` and `fromPatp`, for converting
-between representations. You can render a `patp` value via the `render`
-function, and parse one from Text via `parse`.
+The library exposes two families of functions, `patp` and `fromPatp`, and then
+`patq` and `fromPatq`, for converting between representations appropriately.
+You can render `{patp, patq}` values via the `render{Patp, Patq}` functions,
+and parse them from Text via `parse{Patp, Patq}` respectively.
-The `clan` and `sein` functions, for determining a ship's class and (default)
-parent, are also exposed.
+The useful `clan` and `sein` functions, for determining a ship's class and
+(default) parent, are also exposed.
Here are some quick examples:
@@ -31,11 +33,14 @@ Here are some quick examples:
> :set -XOverloadedStrings
> import qualified Urbit.Ob as Ob
> let nidsut = Ob.patp 15663360
-> Ob.render nidsut
+> let marzod = Ob.patq (Ob.fromPatp nidsut)
+> Ob.renderPatp nidsut
"~nidsut-tomdun"
+> Ob.renderPatq marzod
+"~mun-marzod"
> Ob.fromPatp nidsut
15663360
-> Ob.parse "~nidsut-tomdun"
+> Ob.parsePatp "~nidsut-tomdun"
Right ~nidsut-tomdun
> Ob.clan nidsut
Planet
diff --git a/lib/Urbit/Ob/Co.hs b/lib/Urbit/Ob/Co.hs
@@ -16,12 +16,19 @@
module Urbit.Ob.Co (
Patp
+ , Patq
, patp
+ , patq
+
, fromPatp
+ , fromPatq
+
+ , renderPatp
+ , renderPatq
- , render
- , parse
+ , parsePatp
+ , parsePatq
) where
import qualified Data.ByteString as BS
@@ -46,14 +53,27 @@ import qualified Urbit.Ob.Ob as Ob (fein, fynd)
--
-- (It's also used for naming comets, i.e. self-signed 128-bit Urbit ships.)
--
-newtype Patp = Patp BS.ByteString
- deriving (Eq, Generic)
+newtype Patp = Patp {
+ unPatp :: BS.ByteString
+ } deriving (Eq, Generic)
instance Show Patp where
- show = T.unpack . render
+ show = T.unpack . renderPatp
+
+-- | Hoon's \@q encoding.
+--
+-- Unlike \@p, the \@q encoding is a /non-obfuscated/ representation of an
+-- atom.
+--
+-- It's typically used for serializing arbitrary data in a memorable and
+-- pronounceable fashion.
+--
+newtype Patq = Patq {
+ unPatq :: BS.ByteString
+ } deriving (Eq, Generic)
-unPatp :: Patp -> BS.ByteString
-unPatp (Patp p) = p
+instance Show Patq where
+ show = T.unpack . renderPatq
-- | Convert a 'Natural' to \@p.
--
@@ -69,6 +89,20 @@ unPatp (Patp p) = p
patp :: Natural -> Patp
patp = Patp . BS.reverse . C.unroll . Ob.fein
+-- | Convert a 'Natural' to \@q.
+--
+-- >>> patq 0
+-- ~zod
+-- >>> patp 256
+-- ~marzod
+-- >>> patp 65536
+-- ~nec-dozzod
+-- >>> patp 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+-- ~fipfes-fipfes-fipfes-fipfes-fipfes-fipfes-fipfes-fipfes
+--
+patq :: Natural -> Patq
+patq = Patq . BS.reverse . C.unroll
+
-- | Convert a \@p value to its corresponding 'Natural'.
--
-- >>> let zod = patp 0
@@ -78,17 +112,68 @@ patp = Patp . BS.reverse . C.unroll . Ob.fein
fromPatp :: Patp -> Natural
fromPatp = Ob.fynd . C.roll . BS.reverse . unPatp
+-- | Convert a \@q value to its corresponding 'Natural'.
+--
+-- >>> let zod = patq 0
+-- >>> fromPatq zod
+-- 0
+--
+fromPatq :: Patq -> Natural
+fromPatq = C.roll . BS.reverse . unPatq
+
-- | Render a \@p value as 'T.Text'.
--
--- >>> render (patp 0)
+-- >>> renderPatp (patp 0)
-- "~zod"
--- >>> render (patp 15663360)
+-- >>> renderPatp (patp 15663360)
-- "~nidsut-tomdun"
-render :: Patp -> T.Text
-render (Patp bs) = render' bs
+renderPatp :: Patp -> T.Text
+renderPatp (Patp bs) = render' Padding LongSpacing bs
-render' :: BS.ByteString -> T.Text
-render' bs =
+-- | Render a \@p value as 'T.Text'.
+--
+-- >>> renderPatq (patq 0)
+-- "~zod"
+-- >>> renderPatq (patq 15663360)
+-- "~mun-marzod"
+renderPatq :: Patq -> T.Text
+renderPatq (Patq bs) = render' NoPadding ShortSpacing bs
+
+-- | Parse a \@p value existing as 'T.Text'.
+--
+-- >>> parsePatp "~nidsut-tomdun"
+-- Right ~nidsut-tomdun
+-- > parsePatp "~fipfes-fipfes-fipfes-doznec"
+-- Right ~fipfes-fipfes-fipfes-doznec
+--
+parsePatp :: T.Text -> Either T.Text Patp
+parsePatp = fmap Patp . parse
+
+-- | Parse a \@q value existing as 'T.Text'.
+--
+-- >>> parsePatq "~nec-dozzod"
+-- Right ~nec-dozzod
+-- > parsePatq "~fipfes-fipfes-fipfes-doznec"
+-- Right ~fipfes-fipfes-fipfes-doznec
+--
+parsePatq :: T.Text -> Either T.Text Patq
+parsePatq = fmap Patq . parse
+
+-- Padding option for rendering.
+data Padding =
+ Padding
+ | NoPadding
+ deriving Eq
+
+-- Spacing option for rendering.
+data Spacing =
+ LongSpacing
+ | ShortSpacing
+ deriving Eq
+
+-- General-purpose renderer.
+render' :: Padding -> Spacing -> BS.ByteString -> T.Text
+render' padding spacing bs =
T.cons '~'
. snd
. BS.foldr alg (0 :: Int, mempty)
@@ -97,27 +182,29 @@ render' bs =
alg val (idx, acc) =
let syl = if even idx then suffix val else prefix val
glue
- | idx `mod` 8 == 0 = if idx == 0 then mempty else "--"
+ | idx `mod` 8 == 0 = if idx == 0 then mempty else dash
| even idx = "-"
| otherwise = mempty
in (succ idx, syl <> glue <> acc)
- padded =
+ padded
+ | padCondition = BS.cons 0 bs
+ | otherwise = bs
+
+ dash = case spacing of
+ LongSpacing -> "--"
+ ShortSpacing -> "-"
+
+ padCondition =
let len = BS.length bs
- in if (odd len && len > 2) || len == 0
- then BS.cons 0 bs
- else bs
+ in case padding of
+ NoPadding -> len == 0
+ Padding -> (odd len && len > 2) || len == 0
--- | Parse a \@p value existing as 'T.Text'.
---
--- >>> parse "~nidsut-tomdun"
--- Right ~nidsut-tomdun
--- > parse "~fipfes-fipfes-fipfes-doznec"
--- Right ~fipfes-fipfes-fipfes-doznec
---
-parse :: T.Text -> Either T.Text Patp
+-- General-purpose (non-strict) parser.
+parse :: T.Text -> Either T.Text BS.ByteString
parse p =
- fmap (Patp . snd)
+ fmap snd
$ foldrM alg (0 :: Int, mempty) syls
where
alg syl (idx, acc) = do
diff --git a/test/Co/Tests/Property.hs b/test/Co/Tests/Property.hs
@@ -4,7 +4,7 @@ module Co.Tests.Property (
) where
import qualified Data.Text as T
-import Data.Word (Word32)
+import Data.Word (Word64)
import Numeric.Natural (Natural)
import Test.Hspec
import Test.Hspec.Core.QuickCheck (modifyMaxSuccess)
@@ -12,13 +12,19 @@ import Test.QuickCheck
import qualified Urbit.Ob.Co as Co
nats :: Gen Natural
-nats = fmap fromIntegral (arbitrary :: Gen Word32)
+nats = fmap fromIntegral (arbitrary :: Gen Word64)
patps :: Gen Co.Patp
patps = fmap Co.patp nats
+patqs :: Gen Co.Patq
+patqs = fmap Co.patq nats
+
patpStrings :: Gen T.Text
-patpStrings = fmap Co.render patps
+patpStrings = fmap Co.renderPatp patps
+
+patqStrings :: Gen T.Text
+patqStrings = fmap Co.renderPatq patqs
tests :: Spec
tests = do
@@ -32,11 +38,29 @@ tests = do
it "inverts fromPatp" $
forAll patps $ \x -> Co.patp (Co.fromPatp x) == x
- describe "render" $
+ describe "renderPatp" $
modifyMaxSuccess (const 1000) $
- it "inverts parse" $
+ it "inverts parsePatp" $
forAll patpStrings $ \x ->
- case Co.parse x of
+ case Co.parsePatp x of
+ Left _ -> False
+ Right p -> Co.renderPatp p == x
+
+ describe "fromPatq" $
+ modifyMaxSuccess (const 1000) $
+ it "inverts patq" $
+ forAll nats $ \x -> Co.fromPatq (Co.patq x) == x
+
+ describe "patq" $
+ modifyMaxSuccess (const 1000) $
+ it "inverts fromPatq" $
+ forAll patqs $ \x -> Co.patq (Co.fromPatq x) == x
+
+ describe "renderPatq" $
+ modifyMaxSuccess (const 1000) $
+ it "inverts parsePatq" $
+ forAll patqStrings $ \x ->
+ case Co.parsePatq x of
Left _ -> False
- Right p -> Co.render p == x
+ Right p -> Co.renderPatq p == x
diff --git a/test/Co/Tests/Unit.hs b/test/Co/Tests/Unit.hs
@@ -9,32 +9,61 @@ import Test.Hspec
import qualified Urbit.Ob.Co as Co
tests :: Spec
-tests =
- describe "render" $ do
+tests = do
+ describe "renderPatp" $ do
it "matches 32-bit reference values" $ do
- Co.render (Co.patp 0) `shouldBe` "~zod"
- Co.render (Co.patp 255) `shouldBe` "~fes"
- Co.render (Co.patp 256) `shouldBe` "~marzod"
- Co.render (Co.patp 65535) `shouldBe` "~fipfes"
- Co.render (Co.patp 65536) `shouldBe` "~dapnep-ronmyl"
- Co.render (Co.patp 15663360) `shouldBe` "~nidsut-tomdun"
- Co.render (Co.patp 0xFFFFFFFF) `shouldBe` "~dostec-risfen"
+ Co.renderPatp (Co.patp 0) `shouldBe` "~zod"
+ Co.renderPatp (Co.patp 255) `shouldBe` "~fes"
+ Co.renderPatp (Co.patp 256) `shouldBe` "~marzod"
+ Co.renderPatp (Co.patp 65535) `shouldBe` "~fipfes"
+ Co.renderPatp (Co.patp 65536) `shouldBe` "~dapnep-ronmyl"
+ Co.renderPatp (Co.patp 15663360) `shouldBe` "~nidsut-tomdun"
+ Co.renderPatp (Co.patp 0xFFFFFFFF) `shouldBe` "~dostec-risfen"
it "matches 64-bit reference values" $ do
let big_64_01 = 0x0000000100000000
- Co.render (Co.patp big_64_01) `shouldBe` "~doznec-dozzod-dozzod"
+ Co.renderPatp (Co.patp big_64_01) `shouldBe` "~doznec-dozzod-dozzod"
let big_64_02 = 0xFFFFFFFFFFFFFFFF
- Co.render (Co.patp big_64_02) `shouldBe` "~fipfes-fipfes-dostec-risfen"
+ Co.renderPatp (Co.patp big_64_02) `shouldBe` "~fipfes-fipfes-dostec-risfen"
it "matches 128-bit reference values" $ do
let big_128_01 = 0x00000000000000010000000000000000
patp_128_01 = "~doznec--dozzod-dozzod-dozzod-dozzod"
- Co.render (Co.patp big_128_01) `shouldBe` patp_128_01
+ Co.renderPatp (Co.patp big_128_01) `shouldBe` patp_128_01
let big_128_02 = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
patp_128_02 =
"~fipfes-fipfes-fipfes-fipfes--fipfes-fipfes-fipfes-fipfes"
- Co.render (Co.patp big_128_02) `shouldBe` patp_128_02
+ Co.renderPatp (Co.patp big_128_02) `shouldBe` patp_128_02
+
+ describe "renderPatq" $ do
+ it "matches 32-bit reference values" $ do
+ Co.renderPatq (Co.patq 0) `shouldBe` "~zod"
+ Co.renderPatq (Co.patq 255) `shouldBe` "~fes"
+ Co.renderPatq (Co.patq 256) `shouldBe` "~marzod"
+ Co.renderPatq (Co.patq 65535) `shouldBe` "~fipfes"
+ Co.renderPatq (Co.patq 65536) `shouldBe` "~nec-dozzod"
+ Co.renderPatq (Co.patq 15663360) `shouldBe` "~mun-marzod"
+ Co.renderPatq (Co.patq 0xFFFFFFFF) `shouldBe` "~fipfes-fipfes"
+
+ it "matches 64-bit reference values" $ do
+ let big_64_01 = 0x0000000100000000
+ Co.renderPatq (Co.patq big_64_01) `shouldBe` "~nec-dozzod-dozzod"
+
+ let big_64_02 = 0xFFFFFFFFFFFFFFFF
+ patq_64_02 = "~fipfes-fipfes-fipfes-fipfes"
+ Co.renderPatq (Co.patq big_64_02) `shouldBe` patq_64_02
+
+ it "matches 128-bit reference values" $ do
+ let big_128_01 = 0x00000000000000010000000000000000
+ patq_128_01 = "~nec-dozzod-dozzod-dozzod-dozzod"
+ Co.renderPatq (Co.patq big_128_01) `shouldBe` patq_128_01
+
+ let big_128_02 = 0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+ patq_128_02 =
+ "~fipfes-fipfes-fipfes-fipfes-fipfes-fipfes-fipfes-fipfes"
+
+ Co.renderPatq (Co.patq big_128_02) `shouldBe` patq_128_02
diff --git a/urbit-hob.cabal b/urbit-hob.cabal
@@ -12,16 +12,20 @@ license-file: LICENSE
build-type: Simple
cabal-version: >= 1.10
description:
- Here you can primarily find functions for dealing with the \"patp\" phonetic
- base used by Urbit. The \@p encoding is used for naming ships; it uniquely
- represents a 32-bit number in a memorable and pronounceable fashion.
+ Here you can primarily find functions for dealing with the \"patp\" and
+ \"patq\" /phonetic bases/ used by Urbit. The \@p encoding is used for naming
+ ships, while the \@q encoding is used for arbitrary data; they each uniquely
+ represent an underlying natural number (or /atom/) in a memorable and
+ pronounceable fashion.
.
- The \@p encoding is an /obfuscated/ representation of an underlying 32-bit
- number, in particular, hence the \"ob\" in the library's name.
+ The \@p encoding is an /obfuscated/ representation of an underlying atom, in
+ particular, hence the \"ob\" in the library's name.
.
- The @Urbit.Ob@ module exposes two functions, 'patp' and 'fromPatp', for
- converting between representations. You can also render a 'Patp' value via
- the 'render' function, or parse one via 'parse'.
+ The @Urbit.Ob@ module exposes two families of functions, 'patp' and
+ 'fromPatp', and then 'patq' and 'fromPatq', for converting between
+ representations. You can also render a 'Patp' or 'Patq' value as 'Text' via
+ the 'renderPatp' and 'renderPatq' functions, or parse them from 'Text' via
+ 'parsePatp' and 'parsePatq'.
.
Since \@p values represent ships, some utilities for dealing with ships are
also exposed. The 'clan' and 'sein' functions are useful for determining a
@@ -31,13 +35,15 @@ description:
.
>>> :set -XOverloadedStrings
>>> import qualified Urbit.Ob as Ob
- >>>
>>> let nidsut = Ob.patp 15663360
- >>> Ob.render nidsut
+ >>> let marzod = Ob.patq (Ob.fromPatp nidsut)
+ >>> Ob.renderPatp nidsut
"~nidsut-tomdun"
+ >>> Ob.renderPatq marzod
+ "~mun-marzod"
>>> Ob.fromPatp nidsut
15663360
- >>> Ob.parse "~nidsut-tomdun"
+ >>> Ob.parsePatp "~nidsut-tomdun"
Right ~nidsut-tomdun
>>> Ob.clan nidsut
Planet
