PS Array Builder

Main.purs

-- Copyright 2021 Nathan Faubion
-- 
-- Permission is hereby granted, free of charge, to any person obtaining a copy
-- of this software and associated documentation files (the "Software"), to deal
-- in the Software without restriction, including without limitation the rights
-- to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-- copies of the Software, and to permit persons to whom the Software is
-- furnished to do so, subject to the following conditions:
-- 
-- The above copyright notice and this permission notice shall be included in
-- all copies or substantial portions of the Software.
-- 
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-- IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-- FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-- AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-- LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-- OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
-- SOFTWARE.

module Main where

import Prelude

import Control.Monad.ST as ST
import Control.Monad.ST.Ref as STRef
import Data.Array.ST as STArray

data Builder a
  = Empty
  | Singleton a
  | Append (Builder a) (Builder a)
  
instance semigroupBuilder :: Semigroup (Builder a) where
  append = case _, _ of
    Empty, a -> a
    a, Empty -> a
    a, b -> Append a b
    
instance monoidBuilder :: Monoid (Builder a) where
  mempty = Empty
  
data Uncons a
  = UnconsNone
  | Uncons a (Builder a)
  
uncons :: forall a. Builder a -> Uncons a
uncons = case _ of
  Empty -> UnconsNone
  Singleton a -> Uncons a Empty
  Append a b -> uncons' a b
  
uncons' :: forall a. Builder a -> Builder a -> Uncons a
uncons' l r = case l of
  Empty -> uncons r
  Singleton a -> Uncons a r
  Append a b -> uncons' a (Append b r)
  
toArray :: forall a. Builder a -> Array a
toArray builder = ST.run do
  arr  <- STArray.empty
  next <- STRef.new builder
  cont <- STRef.new true
  ST.while (STRef.read cont) do
    b <- STRef.read next
    case uncons b of
      UnconsNone -> do
        _ <- STRef.write false cont
        pure unit
      Uncons a c -> do
        _ <- STArray.push a arr
        _ <- STRef.write c next
        pure unit
  STArray.unsafeFreeze arr