From 28ae8bbaf2d8266d604bfa413819fab18a16827a Mon Sep 17 00:00:00 2001
From: Benjamin Summers <benjamin@tlon.io>
Date: Fri, 6 Mar 2020 18:12:53 -0800
Subject: [PATCH 1/2] urbit-atom: Debugging hacks to test in GHCJS.

---
 pkg/hs/urbit-atom/.gitignore                 |  1 +
 pkg/hs/urbit-atom/app/Main.hs                | 30 ++++++++++++++++++++
 pkg/hs/urbit-atom/lib/Urbit/Atom/Internal.hs |  6 ++++
 pkg/hs/urbit-atom/package.yaml               | 27 +++++++++++++-----
 4 files changed, 57 insertions(+), 7 deletions(-)
 create mode 100644 pkg/hs/urbit-atom/app/Main.hs

diff --git a/pkg/hs/urbit-atom/.gitignore b/pkg/hs/urbit-atom/.gitignore
index 777efe33d3..088be03c68 100644
--- a/pkg/hs/urbit-atom/.gitignore
+++ b/pkg/hs/urbit-atom/.gitignore
@@ -1 +1,2 @@
 urbit-atom.cabal
+dist-newstyle/
diff --git a/pkg/hs/urbit-atom/app/Main.hs b/pkg/hs/urbit-atom/app/Main.hs
new file mode 100644
index 0000000000..f48b1cd0d7
--- /dev/null
+++ b/pkg/hs/urbit-atom/app/Main.hs
@@ -0,0 +1,30 @@
+module Main where
+
+import Prelude
+import Urbit.Atom
+import Urbit.Atom.Internal (bit, byt)
+
+main :: IO ()
+main = do
+  print (bit, byt)
+  f "a"
+  f "x"
+  f "aa"
+  f "ax"
+  f "aaa"
+  f "aax"
+  f "aaaa"
+  f "aaax"
+  f "aaaaa"
+  f "aaaax"
+  f "aaaaaa"
+  f "aaaaax"
+  f "aaaaaaa"
+  f "aaaaaax"
+  f "aaaaaaaa"
+  f "aaaaaaax"
+  f "aaaaaaaaa"
+  f "aaaaaaaax"
+
+ where
+  f x = print (x, utf8Atom x)
diff --git a/pkg/hs/urbit-atom/lib/Urbit/Atom/Internal.hs b/pkg/hs/urbit-atom/lib/Urbit/Atom/Internal.hs
index 12370c0f7b..5f319a6853 100644
--- a/pkg/hs/urbit-atom/lib/Urbit/Atom/Internal.hs
+++ b/pkg/hs/urbit-atom/lib/Urbit/Atom/Internal.hs
@@ -50,6 +50,12 @@ import qualified Foreign.ForeignPtr.Unsafe as Ptr
 #error WORD_SIZE_IN_BITS must be either 32 or 64
 #endif
 
+bit :: Word
+bit = BIT
+
+byt :: Word
+byt = BYT
+
 
 --------------------------------------------------------------------------------
 
diff --git a/pkg/hs/urbit-atom/package.yaml b/pkg/hs/urbit-atom/package.yaml
index db6d6fe6c1..f1b955a07d 100644
--- a/pkg/hs/urbit-atom/package.yaml
+++ b/pkg/hs/urbit-atom/package.yaml
@@ -12,14 +12,27 @@ library:
     - -Werror
     - -O2
 
+executables:
+  urbit-atom:
+    source-dirs: app
+    main: Main.hs
+    dependencies:
+      - urbit-atom
+    ghc-options:
+      - -threaded
+      - -rtsopts
+      - -static
+      - -O2
+      - "-with-rtsopts=-N"
+
 dependencies:
-  - base
-  - bytestring
-  - ghc-prim
-  - integer-gmp
-  - primitive
-  - text
-  - vector
+  - base == 4.12.0.0
+  - bytestring == 0.10.8.2
+  - ghc-prim == 0.5.3
+  - integer-gmp == 1.0.2.0
+  - primitive == 0.6.4.0
+  - text == 1.2.3.1
+  - vector == 0.12.0.3
 
 default-extensions:
   - ApplicativeDo

From 8f25a5023282b9cfc8dcb05d81f5c7b5cf9570e5 Mon Sep 17 00:00:00 2001
From: Benjamin Summers <benjamin@tlon.io>
Date: Fri, 6 Mar 2020 23:19:19 -0800
Subject: [PATCH 2/2] Pulled some urbit-atom test from the bowels of git
 history. Not working yet.

---
 pkg/hs/urbit-atom/test/Main.hs | 77 ++++++++++++++++++++++++++++++++++
 1 file changed, 77 insertions(+)
 create mode 100644 pkg/hs/urbit-atom/test/Main.hs

diff --git a/pkg/hs/urbit-atom/test/Main.hs b/pkg/hs/urbit-atom/test/Main.hs
new file mode 100644
index 0000000000..db2b62a30b
--- /dev/null
+++ b/pkg/hs/urbit-atom/test/Main.hs
@@ -0,0 +1,77 @@
+module Main (main) where
+
+--------------------------------------------------------------------------------
+
+tryLoadPill :: PillFile -> IO Atom
+tryLoadPill pill = do
+    a@(MkAtom nat) <- loadAtom (show pill)
+    putStrLn "loaded"
+    print (a > 0)
+    putStrLn "evaled"
+    print (take 10 $ VP.toList $ nat ^. natWords)
+    pure a
+
+tryPackPill :: PillFile -> IO ()
+tryPackPill pf = do
+  atm <- tryLoadPill pf
+  print $ length (atm ^. pill . pillBS)
+
+
+-- Tests -----------------------------------------------------------------------
+
+instance Arbitrary ByteString where
+  arbitrary = fromList <$> arbitrary
+
+instance Arbitrary Pill where
+  arbitrary = Pill <$> arbitrary
+
+instance Arbitrary BigNat where
+  arbitrary = view naturalBigNat <$> arbitrary
+
+instance Show BigNat where
+  show = show . NatJ#
+
+--------------------------------------------------------------------------------
+
+testIso :: Eq a => Iso' a b -> a -> Bool
+testIso iso x = x == (x ^. iso . from iso)
+
+roundTrip :: Eq a => (a -> b) -> (b -> a) -> (a -> Bool)
+roundTrip dump load x = x == load (dump x)
+
+equiv :: Eq b => (a -> b) -> (a -> b) -> (a -> Bool)
+equiv f g x = f x == g x
+
+check :: Atom -> Atom
+check = toAtom . (id :: Integer -> Integer) . fromAtom
+
+--------------------------------------------------------------------------------
+
+prop_packWordSane = equiv (view packedWord) dumbPackWord . fromList
+prop_packWord     = testIso (from packedWord)
+prop_unpackWord   = roundTrip (view packedWord)
+                              (strip . view (from packedWord))
+                  . strip
+                  . take 8
+
+prop_unpackBigNat = testIso bigNatWords
+
+prop_packBigNat   = roundTrip (view (from bigNatWords) . VP.fromList)
+                              (strip . VP.toList . view bigNatWords)
+                  . strip
+
+prop_implodeBytes = roundTrip (view pillWords) (view (from pillWords))
+
+prop_explodeBytes = roundTrip (view (from pillWords) . VP.fromList)
+                              (strip . VP.toList . view pillWords)
+                  . strip
+
+prop_packAtomSane = equiv (view (from pill)) dumbPackAtom . Pill . fromList
+prop_unpackAtom   = roundTrip (view pill) (view (from pill))
+prop_packAtom     = roundTrip (view (from pill)) (view pill) . Pill . strip
+
+
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = $(defaultMainGenerator)