content: {- |
  Module      : Main
  Licence     : MIT (see LICENSE in the distribution)
  
  Maintainer  : github.com/justinethier
  Stability   : experimental
  Portability : portable
  
  This file provides an example of how to use Opaque types to
  store arbitrary haskell data within a LispVal.
  
  Written by Josh Triplett (josh@joshtriplett.org)
  
  To build, use: ghc Opaque.hs
  
  -}
  
  module Main where
  
  import Control.Monad
  import Control.Monad.Error
  import qualified Data.Set as S
  import Language.Scheme.Core
  import Language.Scheme.Primitives
  import Language.Scheme.Types
  import Language.Scheme.Variables
  
  unpackSet :: LispVal -> ThrowsError (S.Set String)
  unpackSet = fromOpaque
  
  primSingleton :: [LispVal] -> ThrowsError LispVal
  primSingleton [e] = liftM (toOpaque . S.singleton) (unpackStr e)
  primSingleton badArgs = throwError $ NumArgs (Just 1) badArgs
  
  primElem :: [LispVal] -> ThrowsError LispVal
  primElem [e, s] = liftM Bool $ liftM2 (S.member) (unpackStr e) (unpackSet s)
  primElem badArgs = throwError $ NumArgs (Just 2) badArgs
  
  primUnion :: [LispVal] -> ThrowsError LispVal
  primUnion = liftM (toOpaque . S.unions) . mapM unpackSet
  
  setBindings :: [(String, LispVal)]
  setBindings = [
          ("nullSet", toOpaque (S.empty :: S.Set String)),
          ("singleton", PrimitiveFunc primSingleton),
          ("elem", PrimitiveFunc primElem),
          ("union", PrimitiveFunc primUnion)
      ]
  
  main :: IO ()
  main = do
      env <- nullEnv >>= flip extendEnv [((varNamespace, name), value) | (name, value) <- setBindings]
      -- Correct usage
      evalAndPrint env "(elem \"hello\" (union (singleton \"hello\") nullSet (singleton \"world\")))"
      -- Scheme type error
      evalAndPrint env "(elem \"hello\" 42)"
  