module System.Console.CmdArgs.Implicit.Capture(
Capture(..), capture, many, (&=)
) where
import Data.Data(Data)
import Data.IORef
import System.IO.Unsafe
import Control.Exception
import System.Console.CmdArgs.Implicit.Ann
import Data.Generics.Any
infixl 2 &=
data Capture
= Many [Capture]
| Ann Ann Capture
| Value Any
| Missing Any
| Ctor Any [Capture]
deriving Show
ref :: IORef [Either (Capture -> Capture) Capture]
ref = unsafePerformIO $ newIORef []
push = modifyIORef ref (Left id :)
pop = do x:xs <- readIORef ref; writeIORef ref xs; return x
modify f = modifyIORef ref $ \x -> case x of Left g : rest -> f g : rest ; _ -> error "Internal error in Capture"
add f = modify $ \x -> Left $ x . f
set x = modify $ \f -> Right $ f x
many :: Data a => [a] -> a
many xs = unsafePerformIO $ do
ys <- mapM (force . Any) xs
set $ Many ys
return $ head xs
(&=) :: Data a => a -> Ann -> a
(&=) x y = unsafePerformIO $ do
add (Ann y)
evaluate x
return x
capture :: Any -> Capture
capture x = unsafePerformIO $ force x
force :: Any -> IO Capture
force x@(Any xx) = do
push
res <- try $ evaluate xx
y <- pop
case y of
_ | Left (_ :: RecConError) <- res -> return $ Missing x
Right r -> return r
Left f | not $ isAlgType x -> return $ f $ Value x
| otherwise -> do
cs <- mapM force $ children x
return $ f $ Ctor x cs