pi/src/Core/Misc.idr

module Core.Misc

import Control.Monad.RWS
import Control.Monad.Identity
import Control.Monad.Either

import Data.Nat
import Data.Vect
import Data.IORef
import Data.IOArray

%default total

public export
Index : Type
Index = Nat

public export
Name : Type
Name = String

public export
PI : Type -> Type
PI = EitherT String IO

public export
data NST : Type where
public export
data DTY : Type where
public export
data DTR : Type where

public export
data RefP : Type -> Type -> Type where
  MkRefP : (label : Type) -> a -> RefP label a

public export
RefA : Type -> Type -> Type
RefA label a = RefP label (IOArray a)

public export
Ref : Type -> Type -> Type
Ref label a = RefP label (IORef a)

public export
getRef : HasIO io => (label : Type) -> {auto ref : Ref label a} -> io a
getRef _ {ref = MkRefP _ ref} = readIORef ref

public export
putRef : HasIO io => (label : Type) -> {auto ref : Ref label a} -> a -> io ()
putRef _ {ref = MkRefP _ ref} = writeIORef ref

public export
getArr : HasIO io => (label : Type) -> {auto ref : RefA label a} -> Int -> io (Maybe a)
getArr _ {ref = MkRefP _ ref} = readArray ref

public export
putArr : HasIO io => (label : Type) -> {auto ref : RefA label a} -> Int -> a -> io Bool
putArr _ {ref = MkRefP _ ref} = writeArray ref

public export
resolve : PI a -> IO (Either String a)
resolve a = runEitherT a

public export
oops : String -> PI a
oops = left

public export
guardS : String -> Bool -> PI ()
guardS str True  = pure ()
guardS str False = oops str

public export
fresh : {auto frst : Ref NST Nat} -> PI Nat
fresh = do
  i <- getRef NST
  putRef NST (S i)
  pure i