{- |
Module      : Language.Scheme.Plugins.CPUTime
Copyright   : Justin Ethier
Licence     : MIT (see LICENSE in the distribution)

Maintainer  : github.com/justinethier
Stability   : experimental
Portability : portable

This module wraps System.CPUTime so that it can be used directly by Scheme code.

More importantly, it serves as an example of how to wrap existing Haskell code so
that it can be loaded and called by husk.

See 'examples/ffi/ffi-cputime.scm' in the husk source tree for an example of how to
call into this module from Scheme code.
-}

module Language.Scheme.Plugins.CPUTime (get, precision) where

import Language.Scheme.Types
import System.CPUTime
import Control.Monad.Except

-- |Wrapper for CPUTime.getCPUTime
get :: [LispVal] -> IOThrowsError LispVal
get :: [LispVal] -> IOThrowsError LispVal
get [] = do
  Integer
t <- IO Integer -> ExceptT LispError IO Integer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> ExceptT LispError IO Integer)
-> IO Integer -> ExceptT LispError IO Integer
forall a b. (a -> b) -> a -> b
$ IO Integer
System.CPUTime.getCPUTime
  LispVal -> IOThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> IOThrowsError LispVal)
-> LispVal -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Integer -> LispVal
Number Integer
t
get [LispVal]
badArgList = LispError -> IOThrowsError LispVal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LispError -> IOThrowsError LispVal)
-> LispError -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [LispVal] -> LispError
NumArgs (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0) [LispVal]
badArgList

-- |Wrapper for CPUTime.cpuTimePrecision
precision :: [LispVal] -> IOThrowsError LispVal
precision :: [LispVal] -> IOThrowsError LispVal
precision [] = LispVal -> IOThrowsError LispVal
forall (m :: * -> *) a. Monad m => a -> m a
return (LispVal -> IOThrowsError LispVal)
-> LispVal -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Integer -> LispVal
Number (Integer -> LispVal) -> Integer -> LispVal
forall a b. (a -> b) -> a -> b
$ Integer
System.CPUTime.cpuTimePrecision
precision [LispVal]
badArgList = LispError -> IOThrowsError LispVal
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (LispError -> IOThrowsError LispVal)
-> LispError -> IOThrowsError LispVal
forall a b. (a -> b) -> a -> b
$ Maybe Integer -> [LispVal] -> LispError
NumArgs (Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
0) [LispVal]
badArgList