content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE ForeignFunctionInterface #-}
  {-# LANGUAGE JavaScriptFFI #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  {-
    Copyright 2020 The CodeWorld Authors. All rights reserved.
  
    Licensed under the Apache License, Version 2.0 (the "License");
    you may not use this file except in compliance with the License.
    You may obtain a copy of the License at
  
        http://www.apache.org/licenses/LICENSE-2.0
  
    Unless required by applicable law or agreed to in writing, software
    distributed under the License is distributed on an "AS IS" BASIS,
    WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
    See the License for the specific language governing permissions and
    limitations under the License.
  -}
  {-
      Thanks to Luite Stegeman, whose code this is heavily based on.
  
      Note that this code is very dependent on the internals of GHCJS, so
      complain if this is broken.  It's not unlikely.
  -}
  {- If you want to do these things you are a bad person and you should feel bad -}
  module Internal.Truth where
  
  import Control.Exception (evaluate)
  import Control.Monad
  import GHC.Prim (reallyUnsafePtrEquality#)
  import System.IO.Unsafe
  import Unsafe.Coerce
  import qualified "base" Prelude as P
  import "base" Prelude (($), Bool, IO, Int)
  
  #ifdef ghcjs_HOST_OS
  import GHCJS.Foreign
  import GHCJS.Types
  import JavaScript.Array
  #else
  import "base" Prelude (error)
  #endif
  type Truth = Bool
  
  ifThenElse :: Truth -> a -> a -> a
  ifThenElse a b c =
    if a
      then b
      else c
  
  infix 4 ==, /=
  
  infixr 3 &&
  
  infixr 2 ||
  
  -- | Compares values to see if they are equal.
  (==) :: a -> a -> Truth
  a == b =
    a `P.seq` b
      `P.seq` case reallyUnsafePtrEquality# a b of
        1# -> P.True
        _ -> deepEq a b
  
  {-# RULES
  "equality/bool" forall (x :: P.Bool). (==) x = (P.==) x
    #-}
  
  -- | Compares values to see if they are not equal.
  -- Note that @a /= b@ is the same as @not (a == b)@.
  (/=) :: a -> a -> Truth
  a /= b = not (a == b)
  
  (&&) :: Truth -> Truth -> Truth
  (&&) = (P.&&)
  
  (||) :: Truth -> Truth -> Truth
  (||) = (P.||)
  
  not :: Truth -> Truth
  not = P.not
  
  otherwise :: Truth
  otherwise = P.otherwise
  
  #ifdef ghcjs_HOST_OS
  -- traverse the object and get the thunks out of it
  foreign import javascript unsafe "cw$getThunks($1)" js_getThunks ::
                 Int -> IO JSArray
  
  foreign import javascript unsafe "cw$deepEq($1, $2)" js_deepEq ::
                 Int -> Int -> IO Bool
  
  data JSRefD a =
      JSRefD a
  
  evaluateFully :: a -> IO a
  evaluateFully x = do
      x' <- evaluate x
      ths <- js_getThunks (unsafeCoerce x')
      when (not $ isNull $ unsafeCoerce ths) $ forM_ (toList ths) evalElem
      return x'
    where
      evalElem :: JSVal -> IO ()
      evalElem y =
          let (JSRefD o) = unsafeCoerce y
          in void (evaluateFully o)
  
  deepEq :: a -> a -> Bool
  deepEq x y =
      unsafePerformIO $ do
          x' <- evaluateFully x
          y' <- evaluateFully y
          js_deepEq (unsafeCoerce x') (unsafeCoerce y')
  #else
  evaluateFully :: a -> IO a
  evaluateFully x = error "Only available with GHCJS"
  
  deepEq :: a -> a -> Bool
  deepEq x y = error "Only available with GHCJS"
  #endif
  