But Why Though

UntypedArray.hs

{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

import Control.Monad
import Control.Exception
import GHC.Exts
import GHC.IO
import GHC.Prim
import System.IO.Unsafe

data UntypedArray =
  UntypedArray
  { _size :: Int#
  , _array :: SmallArray# Any
  }

empty :: UntypedArray
empty =
  unsafePerformIO $! IO $ \s0 ->
    case newSmallArray# 0# (error "empty") s0 of
      (# s1, arr0 #) ->
        case unsafeFreezeSmallArray# arr0 s1 of
          (# s2, arr1 #) -> (# s2, UntypedArray 0# arr1 #)

append :: UntypedArray -> a -> UntypedArray
append (UntypedArray size arr0) a =
  let
    newSize = size +# 1#
  in
    unsafePerformIO $! IO $ \s0 ->
      case newSmallArray# newSize (error "append") s0 of
        (# s1, arr1 #) ->
          case copySmallArray# arr0 0# arr1 0# size s1 of
            s2 ->
              case writeSmallArray# arr1 size (unsafeCoerce# a) s2 of
                s3 ->
                  case unsafeFreezeSmallArray# arr1 s3 of
                    (# s4, arr2 #) -> (# s4, UntypedArray newSize arr2 #)

infixl 5 |>
(|>) :: UntypedArray -> a -> UntypedArray
(|>) = append

prepend :: a -> UntypedArray -> UntypedArray
prepend a (UntypedArray size arr0) =
  let
    newSize = size +# 1#
  in
    unsafePerformIO $! IO $ \s0 ->
      case newSmallArray# newSize (error "prepend") s0 of
        (# s1, arr1 #) ->
          case copySmallArray# arr0 0# arr1 1# size s1 of
            s2 ->
              case writeSmallArray# arr1 0# (unsafeCoerce# a) s2 of
                s3 ->
                  case unsafeFreezeSmallArray# arr1 s3 of
                    (# s4, arr2 #) -> (# s4, UntypedArray newSize arr2 #)

infixr 5 <|
(<|) :: a -> UntypedArray -> UntypedArray
(<|) = prepend

get :: forall a. Int -> UntypedArray -> a
get (I# index) (UntypedArray _ arr0) =
  unsafePerformIO $! IO $ \s0 ->
    case unsafeThawSmallArray# arr0 s0 of
      (# s1, arr1 #) ->
        case readSmallArray# arr1 index s1 of
          (# s2, a #) -> (# s2, unsafeCoerce# a #)

set :: forall a. Int -> a -> UntypedArray -> UntypedArray
set (I# index) a (UntypedArray size arr0) =
  unsafePerformIO $! IO $ \s0 ->
    case newSmallArray# size (error "set") s0 of
      (# s1, arr1 #) ->
        case copySmallArray# arr0 0# arr1 0# size s1 of
          s2 ->
            case writeSmallArray# arr1 index (unsafeCoerce# a) s2 of
              s3 ->
                case unsafeFreezeSmallArray# arr1 s3 of
                  (# s4, arr2 #) -> (# s4, UntypedArray size arr2 #)

expect :: Bool -> IO ()
expect cond = void (evaluate (assert cond ()))

main :: IO ()
main = do
  let xs = empty |> id @Int 1 |> True |> "hello!" |> id @Double 3.14
  expect $ get @Int 0 xs == 1
  expect $ get @Bool 1 xs == True
  expect $ get @String 2 xs == "hello!"
  expect $ get @Double 3 xs == 3.14
  expect $ get @Bool 0 (set 0 False xs) == False