Add shared example on discord.

drop/ArrayBufferStuff.purs

@@ -0,0 +1,189 @@
+module Main where
+
+import Prelude
+
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Except (ExceptT(ExceptT), withExceptT)
+import Data.Array as Array
+import Data.Either (Either(Left, Right), either, note, hush)
+import Data.Maybe (Maybe(Just, Nothing), maybe, fromMaybe)
+import Data.String as String
+import Data.Traversable (for, for_, traverse, traverse_)
+import Effect (Effect)
+import Effect.Class (liftEffect)
+import Effect.Class.Console as Console
+import Effect.Exception as Exception
+import TryPureScript (Doc, Inline, render, withConsole)
+import Unsafe.Coerce (unsafeCoerce)
+
+import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
+import Data.ArrayBuffer.Builder as Builder
+import Data.ArrayBuffer.Cast (toUint8Array) as Cast
+import Data.ArrayBuffer.DataView as DataView
+import Data.ArrayBuffer.Typed as Typed
+import Data.ArrayBuffer.Types (ArrayBuffer, ArrayView, DataView, Int32)
+import Parsing (ParserT(..), ParseError(..), runParserT)
+import Parsing as Parsing
+import Parsing.DataView (anyInt32be, takeN) as Parsing.DataView
+import Web.Encoding.TextDecoder as TextDecoder
+import Web.Encoding.TextEncoder as TextEncoder
+import Web.Encoding.UtfLabel as UtfLabel
+
+
+--------------------------------------------------------------------------------
+
+program :: Effect Unit
+program = do
+  comment "ArrayBuffer stuff"
+  
+  -- Going to try a round-trip version of the
+  -- example in the `purescript-arraybuffer-builder`
+  -- README file:
+  
+  let
+    input :: String
+    input = "🦝 ééàà"
+  
+  comment $ "We'll try to roundtrip the following: " <> input
+  
+  -- First the ArrayBuffer builder half of the roundtrip:
+  arrayBuffer <- examplePutStringUtf8 input
+  
+
+  -- Then parsing the ArrayBuffer back for the second half of the roundtrip:
+  exampleParseUtf8 arrayBuffer >>= case _ of
+    
+    Left parseError -> do
+      comment "Failure :("
+      Console.logShow parseError
+      
+    Right string -> do
+      comment "SUCCESS!"
+      logString $ "You should see the input string here: " <> string
+
+
+--------------------------------------------------------------------------------
+-- BUILDER example
+
+
+-- modified example from the README at:
+--    https://pursuit.purescript.org/packages/purescript-arraybuffer-builder/3.1.0
+--
+-- as the 'Encode a String as UTF8 with a length prefix into our Builder'
+examplePutStringUtf8 :: String -> Effect ArrayBuffer
+examplePutStringUtf8 s = Builder.execPutM do
+  textEncoder <- liftEffect TextEncoder.new
+  let stringbuf = Typed.buffer $ TextEncoder.encode s textEncoder
+  -- Put a 32-bit big-endian length for the utf8 string, in bytes.
+  Builder.putInt32be $ ArrayBuffer.byteLength stringbuf
+  Builder.putArrayBuffer stringbuf
+
+
+--------------------------------------------------------------------------------
+-- PARSER example
+-- modified example from the README at:
+--    https://pursuit.purescript.org/packages/purescript-parsing-dataview/3.2.4
+--
+-- as the 'Parse a UTF-8 String with a length prefix' example
+exampleParseUtf8 :: ArrayBuffer -> Effect (Either ParseError String)
+exampleParseUtf8 arrayBuffer = do
+  
+  textDecoder <- TextDecoder.new UtfLabel.utf8
+  
+  let
+    dataView = DataView.whole arrayBuffer
+  
+  runParserT dataView do
+    -- First parse a 32-bit big-endian length prefix for the length
+    -- of the UTF-8 string in bytes.
+    length <- Parsing.DataView.anyInt32be
+    stringview <- Parsing.DataView.takeN length
+    stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
+    hoistEffectParserT $ TextDecoder.decode stringarray textDecoder
+  
+ 
+-- I didn't like how the `purescript-parsing-dataview` handled that
+-- part of the example, so made this to help:
+hoistEffectParserT
+  :: forall a
+   . Effect a
+  -> ParserT DataView Effect a
+hoistEffectParserT
+  = Exception.try
+  >>> ExceptT
+  >>> withExceptT Exception.message
+  >>> Parsing.liftExceptT
+
+
+
+
+--------------------------------------------------------------------------------
+-- I/O
+
+main :: Effect Unit
+main = withConsole program >>= renderWithCSS cssArray
+
+
+--------------------------------------------------------------------------------
+-- Utilities (helping me in the absence of a TryPureScript dark mode)
+
+
+renderWithCSS :: Array String -> Doc -> Effect Unit
+renderWithCSS css htmlDoc = render doc
+  where
+  doc :: Doc
+  doc = mkDoc (tagWithStyle' "div" css (unDoc htmlDoc))
+
+cssArray :: Array String
+cssArray =
+  [ "display: block"
+  , "flex-direction: column"
+  , "justify-content: space-between"
+  , "height: calc(100vh - 30px)"
+  , "background: #282c34"
+  , "color: #e06c75"
+  , "font-family: 'Consolas'"
+  , "padding: 5px 20px 5px 20px"
+  ]
+
+logCustom
+  :: String
+  -> String
+  -> Array String
+  -> String
+  -> Effect Unit
+logCustom tag color css = Console.log <<< tagWithStyle' tag css'
+  where
+  css' = ["color: "<> color] <> css
+
+logString :: String -> Effect Unit
+logString = logCustom "span" "#89ca78" []
+
+logShowString :: forall val. Show val => val -> Effect Unit
+logShowString = logCustom "span" "#89ca78" [] <<< show
+
+comment :: String -> Effect Unit
+comment = logCustom "span" "#7f848e" css <<< ("\n-- " <> _)
+  where
+  css = [ "font-style: italic" ]
+
+mkDoc :: String -> Doc
+mkDoc = unsafeCoerce
+
+unDoc :: Doc -> String
+unDoc = unsafeCoerce
+
+unInline :: Inline -> String
+unInline = unsafeCoerce
+
+mkInline :: String -> Inline
+mkInline = unsafeCoerce
+
+tagWithStyle :: String -> String -> Array String -> String -> String
+tagWithStyle open close css html
+  =  "<" <> open <> " style=\"" <> String.joinWith "; " css <> "\">"
+  <> html
+  <> "</" <> close <> ">"
+
+tagWithStyle' :: String -> Array String -> String -> String
+tagWithStyle' open = tagWithStyle open open