diff --git a/drop/ArrayBufferStuff.purs b/drop/ArrayBufferStuff.purs new file mode 100644 index 0000000..ea0c6f0 --- /dev/null +++ b/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