Bytes.{to,from}Base{16,32,64,64UrlUnpadded} builtins

parser-typechecker/src/Unison/Builtin.hs

@@ -385,6 +385,15 @@ builtinsSrc =
   , B "Bytes.size" $ bytes --> nat
   , B "Bytes.flatten" $ bytes --> bytes
 
+  , B "Bytes.toBase16" $ bytes --> bytes
+  , B "Bytes.toBase32" $ bytes --> bytes
+  , B "Bytes.toBase64" $ bytes --> bytes
+  , B "Bytes.toBase64UrlUnpadded" $ bytes --> bytes
+  , B "Bytes.fromBase16" $ bytes --> eithert text bytes
+  , B "Bytes.fromBase32" $ bytes --> eithert text bytes
+  , B "Bytes.fromBase64" $ bytes --> eithert text bytes
+  , B "Bytes.fromBase64UrlUnpadded" $ bytes --> eithert text bytes
+
   , B "List.empty" $ forall1 "a" list
   , B "List.cons" $ forall1 "a" (\a -> a --> list a --> list a)
   , Alias "List.cons" "List.+:"
@@ -511,9 +520,10 @@ infixr -->
 
 io, ioe :: Var v => Type v -> Type v
 io = Type.effect1 () (Type.builtinIO ())
-ioe = io . either (DD.ioErrorType ())
-  where
-  either l r = DD.eitherType () `app` l `app` r
+ioe = io . eithert (DD.ioErrorType ())
+
+eithert :: Var v => Type v -> Type v -> Type v
+eithert l r = DD.eitherType () `app` l `app` r
 
 socket, threadId, handle, unit :: Var v => Type v
 socket = Type.socket ()

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -1146,7 +1146,6 @@ pfop0 :: ForeignOp
 pfop0 instr = ([],) $ TFOp instr []
 
 -- Pure ForeignOp taking 1 boxed value
-{-
 pfopb :: ForeignOp
 pfopb instr
   = ([BX],)
@@ -1154,7 +1153,6 @@ pfopb instr
   $ TFOp instr [b]
   where
   [b] = freshes 1
--}
 
 builtinLookup :: Var v => Map.Map Reference (SuperNormal v)
 builtinLookup
@@ -1470,6 +1468,16 @@ declareForeigns = do
             u _ h = h -- to help typechecker along
         in pure $ Bytes.fromArray out
 
+  declareForeign "Bytes.toBase16" pfopb . mkForeign $ pure . Bytes.toBase16
+  declareForeign "Bytes.toBase32" pfopb . mkForeign $ pure . Bytes.toBase32
+  declareForeign "Bytes.toBase64" pfopb . mkForeign $ pure . Bytes.toBase64
+  declareForeign "Bytes.toBase64UrlUnpadded" pfopb . mkForeign $ pure . Bytes.toBase64UrlUnpadded
+
+  declareForeign "Bytes.fromBase16" pfopb . mkForeign $ pure . Bytes.fromBase16
+  declareForeign "Bytes.fromBase32" pfopb . mkForeign $ pure . Bytes.fromBase32
+  declareForeign "Bytes.fromBase64" pfopb . mkForeign $ pure . Bytes.fromBase64
+  declareForeign "Bytes.fromBase64UrlUnpadded" pfopb . mkForeign $ pure . Bytes.fromBase64UrlUnpadded
+
 hostPreference :: Maybe Text -> SYS.HostPreference
 hostPreference Nothing = SYS.HostAny
 hostPreference (Just host) = SYS.Host $ Text.unpack host

parser-typechecker/src/Unison/Util/Bytes.hs

@@ -3,19 +3,15 @@
 
 module Unison.Util.Bytes where
 
-import Unison.Prelude hiding (empty)
-
-import Data.Monoid (Sum(..))
--- import Prelude hiding (drop)
-import System.IO.Unsafe (unsafeDupablePerformIO)
--- import Data.ByteArray.Methods (unsafeDoIO)
--- import Data.ByteArray.Types
 import Data.Memory.PtrMethods (memCompare, memEqual)
--- import Data.Memory.Internal.Compat
+import Data.Monoid (Sum(..))
 import Foreign.Ptr (plusPtr)
-import Prelude hiding (length, take, drop)
-import qualified Data.FingerTree as T
+import System.IO.Unsafe (unsafeDupablePerformIO)
+import Unison.Prelude hiding (empty)
 import qualified Data.ByteArray as B
+import qualified Data.ByteArray.Encoding as BE
+import qualified Data.FingerTree as T
+import qualified Data.Text as Text
 
 -- Bytes type represented as a finger tree of ByteStrings.
 -- Can be efficiently sliced and indexed, using the byte count
@@ -40,6 +36,13 @@ size (Bytes bs) = getSum (T.measure bs)
 chunks :: Bytes -> [View B.Bytes]
 chunks (Bytes b) = toList b
 
+fromChunks :: [View B.Bytes] -> Bytes
+fromChunks = foldl' snocView empty
+
+snocView :: Bytes -> View B.Bytes -> Bytes
+snocView bs b | B.null b = bs
+snocView (Bytes bs) b = Bytes (bs T.|> b)
+
 cons :: B.ByteArrayAccess ba => ba -> Bytes -> Bytes
 cons b bs | B.null b = bs
 cons b (Bytes bs) = Bytes (view (B.convert b) T.<| bs)
@@ -68,11 +71,41 @@ drop n b0@(Bytes bs) = go (T.dropUntil (> Sum n) bs) where
     _ -> s
 
 at :: Int -> Bytes -> Maybe Word8
-at i bs = case drop i bs of
+at i bs = case Unison.Util.Bytes.drop i bs of
+  -- todo: there's a more efficient implementation that does no allocation
   -- note: chunks guaranteed nonempty (see `snoc` and `cons` implementations)
   Bytes (T.viewl -> hd T.:< _) -> Just (B.index hd 0)
   _ -> Nothing
 
+toBase16 :: Bytes -> Bytes
+toBase16 bs = foldl' step empty (chunks bs) where
+  step bs b = snoc bs (BE.convertToBase BE.Base16 b :: B.Bytes)
+
+fromBase16 :: Bytes -> Either Text.Text Bytes
+fromBase16 bs = case traverse convert (chunks bs) of
+  Left e -> Left (Text.pack e)
+  Right bs -> Right (fromChunks (map view bs))
+  where
+    convert b = BE.convertFromBase BE.Base16 b :: Either String B.Bytes
+
+toBase32, toBase64, toBase64UrlUnpadded :: Bytes -> Bytes
+toBase32 = toBase BE.Base32
+toBase64 = toBase BE.Base64
+toBase64UrlUnpadded = toBase BE.Base64URLUnpadded
+
+fromBase32, fromBase64, fromBase64UrlUnpadded :: Bytes -> Either Text.Text Bytes
+fromBase32 = fromBase BE.Base32
+fromBase64 = fromBase BE.Base64
+fromBase64UrlUnpadded = fromBase BE.Base64URLUnpadded
+
+fromBase :: BE.Base -> Bytes -> Either Text.Text Bytes
+fromBase e bs = case BE.convertFromBase e (toArray bs :: B.Bytes) of
+  Left e -> Left (Text.pack e)
+  Right b -> Right $ snocView empty (view b)
+
+toBase :: BE.Base -> Bytes -> Bytes
+toBase e bs = snoc empty (BE.convertToBase e (toArray bs :: B.Bytes) :: B.Bytes)
+
 toWord8s :: Bytes -> [Word8]
 toWord8s bs = chunks bs >>= B.unpack