urbit-hob 0.1.0 → 0.1.1
raw patch · 11 files changed
+282/−118 lines, 11 filesdep +QuickCheckdep +hspecdep +hspec-coredep −containersdep ~base
Dependencies added: QuickCheck, hspec, hspec-core, vector
Dependencies removed: containers
Dependency ranges changed: base
Files
- lib/Urbit/Ob/Co.hs +10/−11
- lib/Urbit/Ob/Muk.hs +0/−1
- lib/Urbit/Ob/Ob.hs +45/−43
- test/Co.hs +14/−0
- test/Ob.hs +15/−0
- test/Ob/Tests/Med.hs +72/−0
- test/Ob/Tests/Property.hs +22/−0
- test/Ob/Tests/Small.hs +53/−0
- test/Ob/Tests/Unit.hs +15/−0
- test/Small.hs +0/−47
- urbit-hob.cabal +36/−16
lib/Urbit/Ob/Co.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} @@ -11,8 +10,7 @@ ) where import qualified Data.ByteString as BS-import qualified Data.IntMap.Strict as IMS-import Data.Maybe (fromMaybe)+import qualified Data.Vector as V import qualified Data.Serialize as C import qualified Data.Text as T import Data.Word (Word8, Word16, Word)@@ -48,7 +46,8 @@ -- | Render a Patp value as Text. render :: Patp -> T.Text render (Patp p) = prefixed where- grab = fromMaybe (internalErr "render")+ prefix = V.unsafeIndex prefixes . fromIntegral+ suffix = V.unsafeIndex suffixes . fromIntegral prefixed = case T.uncons encoded of Just ('-', pp) -> T.cons '~' pp@@ -57,8 +56,8 @@ encoded = foldr alg mempty pruned where alg (idx, x) acc- | odd idx = grab (IMS.lookup (fromIntegral x) suffixes) <> acc- | otherwise = "-" <> grab (IMS.lookup (fromIntegral x) prefixes) <> acc+ | odd idx = suffix x <> acc+ | otherwise = "-" <> prefix x <> acc pruned = let len = BS.length p@@ -66,8 +65,8 @@ padding (idx, val) = idx /= 1 && val == 0 in dropWhile padding indexed -prefixes :: IMS.IntMap T.Text-prefixes = IMS.fromList $ zip [0..]+prefixes :: V.Vector T.Text+prefixes = V.fromList ["doz","mar","bin","wan","sam","lit","sig","hid","fid","lis","sog","dir" ,"wac","sab","wis","sib","rig","sol","dop","mod","fog","lid","hop","dar" ,"dor","lor","hod","fol","rin","tog","sil","mir","hol","pas","lac","rov"@@ -91,8 +90,8 @@ ,"lap","tal","pit","nam","bon","ros","ton","fod","pon","sov","noc","sor" ,"lav","mat","mip","fip"] -suffixes :: IMS.IntMap T.Text-suffixes = IMS.fromList $ zip [0..]+suffixes :: V.Vector T.Text+suffixes = V.fromList ["zod","nec","bud","wes","sev","per","sut","let","ful","pen","syt","dur" ,"wep","ser","wyl","sun","ryp","syx","dyr","nup","heb","peg","lup","dep" ,"dys","put","lug","hec","ryt","tyv","syd","nex","lun","mep","lut","sep"@@ -124,7 +123,7 @@ met :: Integral a => a -> a -> a met = loop 0 where- loop !acc a !b+ loop !acc a b | b == 0 = acc | otherwise = loop (succ acc) a (rsh a 1 b)
lib/Urbit/Ob/Muk.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -Wall #-} module Urbit.Ob.Muk ( muk
lib/Urbit/Ob/Ob.hs view
@@ -1,4 +1,4 @@-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE BangPatterns #-} module Urbit.Ob.Ob ( fein@@ -20,7 +20,7 @@ -- | Conceal structure v3. fein :: (Integral a, Bits a) => a -> a fein = loop where- loop pyn =+ loop !pyn = let lo = pyn .&. 0xFFFFFFFF hi = pyn .&. 0xFFFFFFFF00000000 p32 = fromIntegral pyn :: Word32@@ -33,7 +33,7 @@ -- | Restore structure v3. fynd :: (Integral a, Bits a) => a -> a fynd = loop where- loop cry =+ loop !cry = let lo = cry .&. 0xFFFFFFFF hi = cry .&. 0xFFFFFFFF00000000 c32 = fromIntegral cry :: Word32@@ -74,14 +74,13 @@ -- | 'Fe' in B&R (2002). capFe- :: Integral a- => Int- -> a- -> a- -> a- -> (Int -> a -> a)- -> a- -> a+ :: Int+ -> Word32+ -> Word32+ -> Word32+ -> (Int -> Word32 -> Word32)+ -> Word32+ -> Word32 capFe r a b k f m | c < k = c | otherwise = fe r a b f c@@ -90,40 +89,44 @@ -- | 'fe' in B&R (2002). fe- :: Integral a- => Int- -> a- -> a- -> (Int -> a -> a)- -> a- -> a+ :: Int+ -> Word32+ -> Word32+ -> (Int -> Word32 -> Word32)+ -> Word32+ -> Word32 fe r a b f m = loop 1 capL capR where capL = m `mod` a capR = m `div` a- loop j ell arr+ loop j !ell !arr | j > r =- if odd r+ if odd r || arr == a then a * arr + ell- else if arr == a- then a * arr + ell- else a * ell + arr+ else a * ell + arr | otherwise =- let eff = f (pred j) arr- tmp = if odd j- then (ell + eff) `mod` a- else (ell + eff) `mod` b+ let eff = f (pred j) arr+ -- NB (jtobin):+ --+ -- note that the "extra" modulo operators here are not redundant as+ -- the addition of ell and eff can (silently) overflow Word32.+ -- modulo p does not distribute over addition, but it does+ -- "distribute modulo p," so this ensures we stay sufficiently+ -- small.+ tmp = if odd j+ then (ell `mod` a + eff `mod` a) `mod` a+ else (ell `mod` b + eff `mod` b) `mod` b+ in loop (succ j) arr tmp -- | 'Fen' in B&R (2002). capFen- :: Integral a- => Int- -> a- -> a- -> a- -> (Int -> a -> a)- -> a- -> a+ :: Int+ -> Word32+ -> Word32+ -> Word32+ -> (Int -> Word32 -> Word32)+ -> Word32+ -> Word32 capFen r a b k f m | c <= k = c | otherwise = fen r a b f c@@ -132,13 +135,12 @@ -- | 'fen' in B&R (2002). fen- :: Integral a- => Int- -> a- -> a- -> (Int -> a -> a)- -> a- -> a+ :: Int+ -> Word32+ -> Word32+ -> (Int -> Word32 -> Word32)+ -> Word32+ -> Word32 fen r a b f m = loop r capL capR where ahh = if odd r@@ -160,7 +162,7 @@ then ale else ahh - loop j ell arr+ loop j !ell !arr | j < 1 = a * arr + ell | otherwise = let eff = f (pred j) ell
+ test/Co.hs view
@@ -0,0 +1,14 @@+module Main where++import Test.Hspec+import Test.Hspec.Core.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck+import qualified Urbit.Ob.Co as Co++main :: IO ()+main = hspec $+ describe "fromPatp" $+ modifyMaxSuccess (const 1000) $+ it "inverts patp" $+ property $ \(NonNegative x) -> Co.fromPatp (Co.patp x) == x+
+ test/Ob.hs view
@@ -0,0 +1,15 @@+module Main where++import qualified Ob.Tests.Small as S+import qualified Ob.Tests.Med as M+import qualified Ob.Tests.Property as P+import qualified Ob.Tests.Unit as U+import Test.Hspec++main :: IO ()+main =+ hspec $ do+ context "small input space" S.tests+ context "medium input space" M.tests+ context "32-bit input space" P.tests+ context "unit tests" U.tests
+ test/Ob/Tests/Med.hs view
@@ -0,0 +1,72 @@+module Ob.Tests.Med (+ tests+ ) where++import Control.Monad (unless)+import Data.List (nub, foldl')+import Prelude hiding (tail)+import Test.Hspec+import qualified Urbit.Ob.Ob as Ob++a = 2 ^ 4 - 1+b = 2 ^ 4+c = a * b++emm = [+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,+ 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,+ 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47,+ 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63,+ 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,+ 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95,+ 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111,+ 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122, 123, 124, 125, 126, 127,+ 128, 129, 130, 131, 132, 133, 134, 135, 136, 137, 138, 139, 140, 141, 142, 143,+ 144, 145, 146, 147, 148, 149, 150, 151, 152, 153, 154, 155, 156, 157, 158, 159,+ 160, 161, 162, 163, 164, 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175,+ 176, 177, 178, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191,+ 192, 193, 194, 195, 196, 197, 198, 199, 200, 201, 202, 203, 204, 205, 206, 207,+ 208, 209, 210, 211, 212, 213, 214, 215, 216, 217, 218, 219, 220, 221, 222, 223,+ 224, 225, 226, 227, 228, 229, 230, 231, 232, 233, 234, 235, 236, 237, 238, 239+ ]+++eff _ m = v0 !! fromIntegral m where+ v0 = [+ 106, 54, 57, 110, 216, 157, 90, 138, 148, 205, 214, 229, 25, 104, 217, 70, 16, 91,+ 180, 108, 189, 176, 67, 213, 154, 194, 122, 199, 136, 140, 36, 56, 87, 112, 8, 34,+ 14, 171, 227, 160, 211, 228, 37, 121, 119, 65, 132, 45, 224, 61, 141, 59, 82, 77,+ 74, 20, 130, 181, 123, 186, 166, 42, 81, 172, 105, 196, 44, 135, 156, 192, 116, 39,+ 7, 40, 84, 169, 193, 131, 88, 142, 24, 128, 38, 222, 197, 218, 159, 30, 145, 58,+ 53, 85, 62, 49, 158, 86, 72, 210, 225, 52, 73, 149, 143, 195, 124, 179, 219, 9,+ 200, 64, 51, 48, 26, 234, 27, 232, 231, 153, 190, 133, 109, 126, 6, 178, 183, 151,+ 117, 46, 161, 43, 185, 236, 127, 89, 223, 23, 69, 68, 209, 139, 19, 33, 79, 164,+ 207, 50, 144, 31, 134, 170, 29, 107, 220, 184, 47, 103, 206, 201, 175, 125, 35, 114,+ 146, 10, 55, 152, 98, 1, 168, 215, 28, 237, 101, 17, 155, 118, 83, 147, 115, 100,+ 233, 4, 66, 0, 150, 203, 22, 5, 174, 11, 18, 177, 3, 165, 99, 167, 202, 212,+ 163, 182, 80, 162, 71, 97, 12, 60, 113, 221, 204, 41, 226, 187, 63, 230, 2, 188,+ 208, 76, 191, 235, 93, 13, 111, 238, 78, 198, 21, 92, 95, 94, 96, 102, 120, 239,+ 32, 129, 15, 173, 137, 75+ ]++feis = Ob.capFe 4 a b c eff++tail = Ob.capFen 4 a b c eff++tests :: Spec+tests = do+ let perm = fmap feis emm+ inv = fmap tail perm+ distincts = nub perm++ describe "feis" $ do+ it "produces distinct elements" $+ length distincts `shouldBe` length perm++ it "permutes successfully" $+ foldl' (\acc x -> x `elem` emm && acc) True perm `shouldBe` True++ describe "tail" $+ it "inverts feis" $+ emm `shouldBe` inv+
+ test/Ob/Tests/Property.hs view
@@ -0,0 +1,22 @@++module Ob.Tests.Property (+ tests+ ) where++import Test.Hspec+import Test.Hspec.Core.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck+import qualified Urbit.Ob.Ob as Ob++tests :: Spec+tests = do+ describe "feis" $+ modifyMaxSuccess (const 1000) $+ it "inverts tail" $+ property $ \x -> Ob.feis (Ob.tail x) == x++ describe "tail" $+ modifyMaxSuccess (const 1000) $+ it "inverts feis" $+ property $ \x -> Ob.tail (Ob.feis x) == x+
+ test/Ob/Tests/Small.hs view
@@ -0,0 +1,53 @@+module Ob.Tests.Small (+ tests+ ) where++import Control.Monad (unless)+import Data.List (nub, foldl')+import Prelude hiding (tail)+import Test.Hspec+import qualified Urbit.Ob.Ob as Ob++a = 2 ^ 2 - 1+b = 2 ^ 2+c = a * b++eff j m =+ let v0 = [5, 9, 2, 6, 4, 0, 8, 7, 1, 10, 3, 11]+ v1 = [2, 1, 0, 3, 10, 4, 9, 5, 7, 11, 6, 8]+ v2 = [10, 6, 7, 1, 0, 11, 3, 9, 5, 2, 8, 4]+ v3 = [11, 0, 3, 5, 9, 8, 6, 10, 4, 1, 2, 7]++ in case j of+ 0 -> v0 !! fromIntegral m+ 1 -> v1 !! fromIntegral m+ 2 -> v2 !! fromIntegral m+ _ -> v3 !! fromIntegral m++feis = Ob.capFe 4 a b c eff++tail = Ob.capFen 4 a b c eff++tests :: Spec+tests = do+ let emm = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]+ perm = fmap feis emm+ inv = fmap tail perm+ rinv = fmap feis inv+ distincts = nub perm++ describe "feis" $ do+ it "produces distinct elements" $+ length distincts `shouldBe` length perm++ it "permutes successfully" $+ foldl' (\acc x -> x `elem` emm && acc) True perm `shouldBe` True++ describe "feis" $+ it "inverts tail" $+ rinv `shouldBe` perm++ describe "tail" $+ it "inverts feis" $+ emm `shouldBe` inv+
+ test/Ob/Tests/Unit.hs view
@@ -0,0 +1,15 @@++module Ob.Tests.Unit (+ tests+ ) where++import Test.Hspec+import qualified Urbit.Ob.Ob as Ob++tests :: Spec+tests =+ describe "tail . feis" $+ context "when applied to 2052065766" $+ it "should be the identity function" $+ Ob.tail (Ob.feis 2052065766) `shouldBe` 2052065766+
− test/Small.hs
@@ -1,47 +0,0 @@-module Main where--import Control.Monad (unless)-import Data.List (nub, foldl')-import Prelude hiding (tail)-import System.Exit (exitSuccess, exitFailure)-import qualified Urbit.Ob.Ob as Ob--a, b, c :: Int-a = 2 ^ 2 - 1-b = 2 ^ 2-c = a * b--eff j m =- let v0 = [5, 9, 2, 6, 4, 0, 8, 7, 1, 10, 3, 11]- v1 = [2, 1, 0, 3, 10, 4, 9, 5, 7, 11, 6, 8]- v2 = [10, 6, 7, 1, 0, 11, 3, 9, 5, 2, 8, 4]- v3 = [11, 0, 3, 5, 9, 8, 6, 10, 4, 1, 2, 7]-- in case j of- 0 -> v0 !! m- 1 -> v1 !! m- 2 -> v2 !! m- _ -> v3 !! m--feis = Ob.capFe 4 a b c eff--tail = Ob.capFen 4 a b c eff--main :: IO ()-main = do- let emm = [0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11]- perm = fmap feis emm- inv = fmap tail perm- distincts = nub perm-- let distinctElems = length distincts == length perm- unless distinctElems exitFailure-- let permuteSuccessful = foldl' (\acc x -> x `elem` emm && acc) True perm- unless permuteSuccessful exitFailure-- let tailInvertsFeis = emm == inv- unless tailInvertsFeis exitFailure-- exitSuccess-
urbit-hob.cabal view
@@ -1,7 +1,7 @@ name: urbit-hob-version: 0.1.0+version: 0.1.1 synopsis: Hoon-style atom manipulation and printing functions-homepage: https://github.com/urbit/urbit-hob#readme+homepage: https://github.com/urbit/urbit-hob bug-reports: https://github.com/urbit/urbit-hob/issues author: Jared Tobin maintainer: jared@jtobin.io@@ -12,26 +12,24 @@ 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+ 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. .- 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 32-bit+ number, in particular, hence the \"ob\" in the library's name. .- The library exposes two functions, 'patp' and 'fromPatp', for converting- between representations. You can render a 'Patp' value via the 'render'- function.+ The @Urbit.Ob@ module exposes two functions, 'patp' and 'fromPatp', for+ converting between representations. You can render a 'Patp' value via the+ 'render' function. . Here's a quick example: . > import qualified Urbit.Ob as Ob > > let nidsut = Ob.patp 15663360- > Ob.render nidsut- "~nidsut-tomdun"- > Ob.fromPatp nidsut- 15663360+ > Ob.render nidsut -- "~nidsut-tomdun"+ > Ob.fromPatp nidsut -- 15663360 source-repository head type: git@@ -60,18 +58,40 @@ base >= 4.7 && < 6 , bytestring >= 0.10 && < 1 , cereal >= 0.5 && < 1- , containers >= 0.5 && < 1 , murmur3 >= 1.0 && < 2 , text >= 1.2 && < 2+ , vector >= 0.12 && < 1 -Test-suite small+Test-suite ob type: exitcode-stdio-1.0 hs-source-dirs: test- main-is: Small.hs+ main-is: Ob.hs+ other-modules:+ Ob.Tests.Small+ Ob.Tests.Med+ Ob.Tests.Property+ Ob.Tests.Unit default-language: Haskell2010 ghc-options: -rtsopts build-depends: base+ , hspec+ , hspec-core+ , QuickCheck+ , urbit-hob++Test-suite co+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Co.hs+ default-language: Haskell2010+ ghc-options:+ -rtsopts+ build-depends:+ base+ , hspec+ , hspec-core+ , QuickCheck , urbit-hob