    {-# LANGUAGE PatternGuards, ScopedTypeVariables, ExistentialQuantification, DeriveDataTypeable #-}
    {-# OPTIONS_GHC -O0 #-}

    -- | This module captures annotations on a value, and builds a 'Capture' value.
    --   This module has two ways of writing annotations:
    --
    --   /Impure/: The impure method of writing annotations is susceptible to over-optimisation by GHC
    --   - sometimes @\{\-\# OPTIONS_GHC -fno-cse \#\-\}@ will be required.
    --
    --   /Pure/: The pure method is more verbose, and lacks some type safety.
    --
    --   As an example of the two styles:
    --
    -- > data Foo = Foo {foo :: Int, bar :: Int}
    --
    --   @ impure = 'capture' $ Foo {foo = 12, bar = 'many' [1 '&=' \"inner\", 2]} '&=' \"top\"@
    --
    --   @ pure = 'capture_' $ 'record' Foo{} [foo := 12, bar :=+ ['atom' 1 '+=' \"inner\", 'atom' 2]] '+=' \"top\"@
    --
    --   Both evaluate to:
    --
    -- > Capture (Ann "top") (Ctor (Foo 12 1) [Value 12, Many [Ann "inner" (Value 1), Value 2]]
    module System.Console.CmdArgs.Annotate(
        -- * Capture framework
        Capture(..), Any(..), fromCapture, defaultMissing,
        -- * Impure
        capture, many, (&=),
        -- * Pure
        capture_, many_, (+=), atom, record, Annotate((:=),(:=+))
        ) where

    import Control.Monad
    import Control.Monad.Trans.State
    import Data.Data(Data,Typeable)
    import Data.List
    import Data.Maybe
    import Data.IORef
    import System.IO.Unsafe
    import Control.Exception
    import Data.Generics.Any

    infixl 2 &=, +=
    infix 3 :=

    -- | The result of capturing some annotations.
    data Capture ann
        = Many [Capture ann] -- ^ Many values collapsed ('many' or 'many_')
        | Ann ann (Capture ann) -- ^ An annotation attached to a value ('&=' or '+=')
        | Value Any -- ^ A value (just a value, or 'atom')
        | Missing Any -- ^ A missing field (a 'RecConError' exception, or missing from 'record')
        | Ctor Any [Capture ann] -- ^ A constructor (a constructor, or 'record')
          deriving Int -> Capture ann -> ShowS
    [Capture ann] -> ShowS
    Capture ann -> String
    (Int -> Capture ann -> ShowS)
    -> (Capture ann -> String)
    -> ([Capture ann] -> ShowS)
    -> Show (Capture ann)
    forall ann. Show ann => Int -> Capture ann -> ShowS
    forall ann. Show ann => [Capture ann] -> ShowS
    forall ann. Show ann => Capture ann -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall ann. Show ann => Int -> Capture ann -> ShowS
    showsPrec :: Int -> Capture ann -> ShowS
    $cshow :: forall ann. Show ann => Capture ann -> String
    show :: Capture ann -> String
    $cshowList :: forall ann. Show ann => [Capture ann] -> ShowS
    showList :: [Capture ann] -> ShowS
    Show

    instance Functor Capture where
        fmap :: forall a b. (a -> b) -> Capture a -> Capture b
    fmap a -> b
    f (Many [Capture a]
    xs) = [Capture b] -> Capture b
    forall ann. [Capture ann] -> Capture ann
    Many ([Capture b] -> Capture b) -> [Capture b] -> Capture b
    forall a b. (a -> b) -> a -> b
    $ (Capture a -> Capture b) -> [Capture a] -> [Capture b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> b) -> Capture a -> Capture b
    forall a b. (a -> b) -> Capture a -> Capture b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) [Capture a]
    xs
        fmap a -> b
    f (Ann a
    a Capture a
    x) = b -> Capture b -> Capture b
    forall ann. ann -> Capture ann -> Capture ann
    Ann (a -> b
    f a
    a) (Capture b -> Capture b) -> Capture b -> Capture b
    forall a b. (a -> b) -> a -> b
    $ (a -> b) -> Capture a -> Capture b
    forall a b. (a -> b) -> Capture a -> Capture b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Capture a
    x
        fmap a -> b
    f (Value Any
    x) = Any -> Capture b
    forall ann. Any -> Capture ann
    Value Any
    x
        fmap a -> b
    f (Missing Any
    x) = Any -> Capture b
    forall ann. Any -> Capture ann
    Missing Any
    x
        fmap a -> b
    f (Ctor Any
    x [Capture a]
    xs) = Any -> [Capture b] -> Capture b
    forall ann. Any -> [Capture ann] -> Capture ann
    Ctor Any
    x ([Capture b] -> Capture b) -> [Capture b] -> Capture b
    forall a b. (a -> b) -> a -> b
    $ (Capture a -> Capture b) -> [Capture a] -> [Capture b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((a -> b) -> Capture a -> Capture b
    forall a b. (a -> b) -> Capture a -> Capture b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f) [Capture a]
    xs

    -- | Return the value inside a capture.
    fromCapture :: Capture ann -> Any
    fromCapture :: forall ann. Capture ann -> Any
    fromCapture (Many (Capture ann
    x:[Capture ann]
    _)) = Capture ann -> Any
    forall ann. Capture ann -> Any
    fromCapture Capture ann
    x
    fromCapture (Ann ann
    _ Capture ann
    x) = Capture ann -> Any
    forall ann. Capture ann -> Any
    fromCapture Capture ann
    x
    fromCapture (Value Any
    x) = Any
    x
    fromCapture (Missing Any
    x) = Any
    x
    fromCapture (Ctor Any
    x [Capture ann]
    _) = Any
    x

    -- | Remove all Missing values by using any previous instances as default values
    defaultMissing :: Capture ann -> Capture ann
    defaultMissing :: forall ann. Capture ann -> Capture ann
    defaultMissing Capture ann
    x = State [(Any, String, Capture ann)] (Capture ann)
    -> [(Any, String, Capture ann)] -> Capture ann
    forall s a. State s a -> s -> a
    evalState (Maybe Any
    -> Maybe String
    -> Capture ann
    -> State [(Any, String, Capture ann)] (Capture ann)
    forall {m :: * -> *} {ann}.
    Monad m =>
    Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f Maybe Any
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing Capture ann
    x) []
        where
            f :: Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f Maybe Any
    ctor Maybe String
    field (Many [Capture ann]
    xs) = ([Capture ann] -> Capture ann)
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b.
    (a -> b)
    -> StateT [(Any, String, Capture ann)] m a
    -> StateT [(Any, String, Capture ann)] m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Capture ann] -> Capture ann
    forall ann. [Capture ann] -> Capture ann
    Many (StateT [(Any, String, Capture ann)] m [Capture ann]
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ (Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> [Capture ann]
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f Maybe Any
    ctor Maybe String
    field) [Capture ann]
    xs
            f Maybe Any
    ctor Maybe String
    field (Ann ann
    a Capture ann
    x) = (Capture ann -> Capture ann)
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b.
    (a -> b)
    -> StateT [(Any, String, Capture ann)] m a
    -> StateT [(Any, String, Capture ann)] m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ann -> Capture ann -> Capture ann
    forall ann. ann -> Capture ann -> Capture ann
    Ann ann
    a) (StateT [(Any, String, Capture ann)] m (Capture ann)
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f Maybe Any
    ctor Maybe String
    field Capture ann
    x
            f Maybe Any
    ctor Maybe String
    field (Value Any
    x) = Capture ann -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a. a -> StateT [(Any, String, Capture ann)] m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ Any -> Capture ann
    forall ann. Any -> Capture ann
    Value Any
    x
            f (Just Any
    ctor) (Just String
    field) (Missing Any
    x) = do
                [(Any, String, Capture ann)]
    s <- StateT [(Any, String, Capture ann)] m [(Any, String, Capture ann)]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
                Capture ann -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a. a -> StateT [(Any, String, Capture ann)] m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ [Capture ann] -> Capture ann
    forall a. HasCallStack => [a] -> a
    head ([Capture ann] -> Capture ann) -> [Capture ann] -> Capture ann
    forall a b. (a -> b) -> a -> b
    $
                    [Capture ann
    x2 | (Any
    ctor2,String
    field2,Capture ann
    x2) <- [(Any, String, Capture ann)]
    s, Any -> TypeRep
    typeOf Any
    ctor TypeRep -> TypeRep -> Bool
    forall a. Eq a => a -> a -> Bool
    == Any -> TypeRep
    typeOf Any
    ctor2, String
    field String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    field2] [Capture ann] -> [Capture ann] -> [Capture ann]
    forall a. [a] -> [a] -> [a]
    ++
                    String -> [Capture ann]
    forall {a}. String -> a
    err (String
    "missing value encountered, no field for " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    field String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " (of type " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show Any
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")")
            f Maybe Any
    _ Maybe String
    _ (Missing Any
    x) = String -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall {a}. String -> a
    err (String -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> String -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ String
    "missing value encountered, but not as a field (of type " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show Any
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
            f Maybe Any
    _ Maybe String
    _ (Ctor Any
    x [Capture ann]
    xs) | [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (Any -> [String]
    fields Any
    x) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Capture ann] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Capture ann]
    xs = do
                [Capture ann]
    ys <- (String
     -> Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> [String]
    -> [Capture ann]
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM (Any
    -> String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    g Any
    x) (Any -> [String]
    fields Any
    x) [Capture ann]
    xs
                Capture ann -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a. a -> StateT [(Any, String, Capture ann)] m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ Any -> [Capture ann] -> Capture ann
    forall ann. Any -> [Capture ann] -> Capture ann
    Ctor (Any -> [Any] -> Any
    recompose Any
    x ([Any] -> Any) -> [Any] -> Any
    forall a b. (a -> b) -> a -> b
    $ (Capture ann -> Any) -> [Capture ann] -> [Any]
    forall a b. (a -> b) -> [a] -> [b]
    map Capture ann -> Any
    forall ann. Capture ann -> Any
    fromCapture [Capture ann]
    ys) [Capture ann]
    ys
            f Maybe Any
    _ Maybe String
    _ (Ctor Any
    x [Capture ann]
    xs) = ([Capture ann] -> Capture ann)
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b.
    (a -> b)
    -> StateT [(Any, String, Capture ann)] m a
    -> StateT [(Any, String, Capture ann)] m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Any -> [Capture ann] -> Capture ann
    forall ann. Any -> [Capture ann] -> Capture ann
    Ctor Any
    x) (StateT [(Any, String, Capture ann)] m [Capture ann]
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ (Capture ann
     -> StateT [(Any, String, Capture ann)] m (Capture ann))
    -> [Capture ann]
    -> StateT [(Any, String, Capture ann)] m [Capture ann]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f Maybe Any
    forall a. Maybe a
    Nothing Maybe String
    forall a. Maybe a
    Nothing) [Capture ann]
    xs

            g :: Any
    -> String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    g Any
    ctor String
    field Capture ann
    x = do
                Capture ann
    y <- Maybe Any
    -> Maybe String
    -> Capture ann
    -> StateT [(Any, String, Capture ann)] m (Capture ann)
    f (Any -> Maybe Any
    forall a. a -> Maybe a
    Just Any
    ctor) (String -> Maybe String
    forall a. a -> Maybe a
    Just String
    field) Capture ann
    x
                ([(Any, String, Capture ann)] -> [(Any, String, Capture ann)])
    -> StateT [(Any, String, Capture ann)] m ()
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
    modify ((Any
    ctor,String
    field,Capture ann
    y)(Any, String, Capture ann)
    -> [(Any, String, Capture ann)] -> [(Any, String, Capture ann)]
    forall a. a -> [a] -> [a]
    :)
                Capture ann -> StateT [(Any, String, Capture ann)] m (Capture ann)
    forall a. a -> StateT [(Any, String, Capture ann)] m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Capture ann
    y

            err :: String -> a
    err String
    x = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "System.Console.CmdArgs.Annotate.defaultMissing, " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    x

    ---------------------------------------------------------------------
    -- IMPURE BIT

    -- test = show $ capture $ many [Just ((66::Int) &= P 1 &= P 2), Nothing &= P 8] &= P 3

    {-
    Notes On Purity
    ---------------

    There is a risk that things that are unsafe will be inlined. That can generally be
    removed by NOININE on everything.

    There is also a risk that things get commoned up. For example:

    foo = trace "1" 1
    bar = trace "1" 1
    main = do
        evaluate foo
        evaluate bar

    Will print "1" only once, since foo and bar share the same pattern. However, if
    anything in the value is a lambda they are not seen as equal. We exploit this by
    defining const_ and id_ as per this module.

    Now anything wrapped in id_ looks different from anything else.
    -}

    {-
    The idea is to keep a stack of either continuations, or values
    If you encounter 'many' you become a value
    If you encounter '&=' you increase the continuation
    -}

    {-# NOINLINE ref #-}
    ref :: IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref :: IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref = IO (IORef [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a. IO a -> a
    unsafePerformIO (IO (IORef [Either (Capture Any -> Capture Any) (Capture Any)])
     -> IORef [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IO (IORef [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a b. (a -> b) -> a -> b
    $ [Either (Capture Any -> Capture Any) (Capture Any)]
    -> IO (IORef [Either (Capture Any -> Capture Any) (Capture Any)])
    forall a. a -> IO (IORef a)
    newIORef []

    push :: IO ()
    push = IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    -> ([Either (Capture Any -> Capture Any) (Capture Any)]
        -> [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref ((Capture Any -> Capture Any)
    -> Either (Capture Any -> Capture Any) (Capture Any)
    forall a b. a -> Either a b
    Left Capture Any -> Capture Any
    forall a. a -> a
    id Either (Capture Any -> Capture Any) (Capture Any)
    -> [Either (Capture Any -> Capture Any) (Capture Any)]
    -> [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a. a -> [a] -> [a]
    :)
    pop :: IO (Either (Capture Any -> Capture Any) (Capture Any))
    pop = do Either (Capture Any -> Capture Any) (Capture Any)
    x:[Either (Capture Any -> Capture Any) (Capture Any)]
    xs <- IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    -> IO [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a. IORef a -> IO a
    readIORef IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref; IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    -> [Either (Capture Any -> Capture Any) (Capture Any)] -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref [Either (Capture Any -> Capture Any) (Capture Any)]
    xs; Either (Capture Any -> Capture Any) (Capture Any)
    -> IO (Either (Capture Any -> Capture Any) (Capture Any))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either (Capture Any -> Capture Any) (Capture Any)
    x
    change :: ((Capture Any -> Capture Any)
     -> Either (Capture Any -> Capture Any) (Capture Any))
    -> IO ()
    change (Capture Any -> Capture Any)
    -> Either (Capture Any -> Capture Any) (Capture Any)
    f = IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    -> ([Either (Capture Any -> Capture Any) (Capture Any)]
        -> [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef [Either (Capture Any -> Capture Any) (Capture Any)]
    ref (([Either (Capture Any -> Capture Any) (Capture Any)]
      -> [Either (Capture Any -> Capture Any) (Capture Any)])
     -> IO ())
    -> ([Either (Capture Any -> Capture Any) (Capture Any)]
        -> [Either (Capture Any -> Capture Any) (Capture Any)])
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \[Either (Capture Any -> Capture Any) (Capture Any)]
    x -> case [Either (Capture Any -> Capture Any) (Capture Any)]
    x of Left Capture Any -> Capture Any
    g : [Either (Capture Any -> Capture Any) (Capture Any)]
    rest -> (Capture Any -> Capture Any)
    -> Either (Capture Any -> Capture Any) (Capture Any)
    f Capture Any -> Capture Any
    g Either (Capture Any -> Capture Any) (Capture Any)
    -> [Either (Capture Any -> Capture Any) (Capture Any)]
    -> [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a. a -> [a] -> [a]
    : [Either (Capture Any -> Capture Any) (Capture Any)]
    rest ; [Either (Capture Any -> Capture Any) (Capture Any)]
    _ -> String -> [Either (Capture Any -> Capture Any) (Capture Any)]
    forall a. HasCallStack => String -> a
    error String
    "Internal error in Capture"
    add :: (Capture Any -> Capture Any) -> IO ()
    add Capture Any -> Capture Any
    f = ((Capture Any -> Capture Any)
     -> Either (Capture Any -> Capture Any) (Capture Any))
    -> IO ()
    change (((Capture Any -> Capture Any)
      -> Either (Capture Any -> Capture Any) (Capture Any))
     -> IO ())
    -> ((Capture Any -> Capture Any)
        -> Either (Capture Any -> Capture Any) (Capture Any))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Capture Any -> Capture Any
    x -> (Capture Any -> Capture Any)
    -> Either (Capture Any -> Capture Any) (Capture Any)
    forall a b. a -> Either a b
    Left ((Capture Any -> Capture Any)
     -> Either (Capture Any -> Capture Any) (Capture Any))
    -> (Capture Any -> Capture Any)
    -> Either (Capture Any -> Capture Any) (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ Capture Any -> Capture Any
    x (Capture Any -> Capture Any)
    -> (Capture Any -> Capture Any) -> Capture Any -> Capture Any
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Capture Any -> Capture Any
    f
    set :: Capture Any -> IO ()
    set Capture Any
    x = ((Capture Any -> Capture Any)
     -> Either (Capture Any -> Capture Any) (Capture Any))
    -> IO ()
    change (((Capture Any -> Capture Any)
      -> Either (Capture Any -> Capture Any) (Capture Any))
     -> IO ())
    -> ((Capture Any -> Capture Any)
        -> Either (Capture Any -> Capture Any) (Capture Any))
    -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Capture Any -> Capture Any
    f -> Capture Any -> Either (Capture Any -> Capture Any) (Capture Any)
    forall a b. b -> Either a b
    Right (Capture Any -> Either (Capture Any -> Capture Any) (Capture Any))
    -> Capture Any -> Either (Capture Any -> Capture Any) (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ Capture Any -> Capture Any
    f Capture Any
    x

    -- | Collapse multiple values in to one.
    {-# NOINLINE many #-}
    many :: Data val => [val] -> val
    many :: forall val. Data val => [val] -> val
    many [val]
    xs = IO val -> val
    forall a. IO a -> a
    unsafePerformIO (IO val -> val) -> IO val -> val
    forall a b. (a -> b) -> a -> b
    $ do
        [Capture Any]
    ys <- (val -> IO (Capture Any)) -> [val] -> IO [Capture Any]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Any -> IO (Capture Any)
    force (Any -> IO (Capture Any))
    -> (val -> Any) -> val -> IO (Capture Any)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . val -> Any
    forall a. Data a => a -> Any
    Any) [val]
    xs
        Capture Any -> IO ()
    set (Capture Any -> IO ()) -> Capture Any -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Capture Any] -> Capture Any
    forall ann. [Capture ann] -> Capture ann
    Many [Capture Any]
    ys
        val -> IO val
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (val -> IO val) -> val -> IO val
    forall a b. (a -> b) -> a -> b
    $ [val] -> val
    forall a. HasCallStack => [a] -> a
    head [val]
    xs

    {-# NOINLINE addAnn #-}
    addAnn :: (Data val, Data ann) => val -> ann -> val
    addAnn :: forall val ann. (Data val, Data ann) => val -> ann -> val
    addAnn val
    x ann
    y = IO val -> val
    forall a. IO a -> a
    unsafePerformIO (IO val -> val) -> IO val -> val
    forall a b. (a -> b) -> a -> b
    $ do
        (Capture Any -> Capture Any) -> IO ()
    add (Any -> Capture Any -> Capture Any
    forall ann. ann -> Capture ann -> Capture ann
    Ann (Any -> Capture Any -> Capture Any)
    -> Any -> Capture Any -> Capture Any
    forall a b. (a -> b) -> a -> b
    $ ann -> Any
    forall a. Data a => a -> Any
    Any ann
    y)
        val -> IO val
    forall a. a -> IO a
    evaluate val
    x
        val -> IO val
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return val
    x

    -- | Capture a value. Note that if the value is evaluated
    --   more than once the result may be different, i.e.
    --
    -- > capture x /= capture x
    {-# NOINLINE capture #-}
    capture :: (Data val, Data ann) => val -> Capture ann
    capture :: forall val ann. (Data val, Data ann) => val -> Capture ann
    capture val
    x = IO (Capture ann) -> Capture ann
    forall a. IO a -> a
    unsafePerformIO (IO (Capture ann) -> Capture ann)
    -> IO (Capture ann) -> Capture ann
    forall a b. (a -> b) -> a -> b
    $ (Capture Any -> Capture ann)
    -> IO (Capture Any) -> IO (Capture ann)
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((Any -> ann) -> Capture Any -> Capture ann
    forall a b. (a -> b) -> Capture a -> Capture b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Any -> ann
    forall a. Typeable a => Any -> a
    fromAny) (IO (Capture Any) -> IO (Capture ann))
    -> IO (Capture Any) -> IO (Capture ann)
    forall a b. (a -> b) -> a -> b
    $ Any -> IO (Capture Any)
    force (Any -> IO (Capture Any)) -> Any -> IO (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ val -> Any
    forall a. Data a => a -> Any
    Any val
    x

    force :: Any -> IO (Capture Any)
    force :: Any -> IO (Capture Any)
    force x :: Any
    x@(Any a
    xx) = do
        IO ()
    push
        Either RecConError a
    res <- IO a -> IO (Either RecConError a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO (Either RecConError a))
    -> IO a -> IO (Either RecConError a)
    forall a b. (a -> b) -> a -> b
    $ a -> IO a
    forall a. a -> IO a
    evaluate a
    xx
        Either (Capture Any -> Capture Any) (Capture Any)
    y <- IO (Either (Capture Any -> Capture Any) (Capture Any))
    pop
        case Either (Capture Any -> Capture Any) (Capture Any)
    y of
            Either (Capture Any -> Capture Any) (Capture Any)
    _ | Left (RecConError
    _ :: RecConError) <- Either RecConError a
    res -> Capture Any -> IO (Capture Any)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture Any -> IO (Capture Any))
    -> Capture Any -> IO (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ Any -> Capture Any
    forall ann. Any -> Capture ann
    Missing Any
    x
            Right Capture Any
    r -> Capture Any -> IO (Capture Any)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Capture Any
    r
            Left Capture Any -> Capture Any
    f | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Any -> Bool
    isAlgType Any
    x -> Capture Any -> IO (Capture Any)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture Any -> IO (Capture Any))
    -> Capture Any -> IO (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ Capture Any -> Capture Any
    f (Capture Any -> Capture Any) -> Capture Any -> Capture Any
    forall a b. (a -> b) -> a -> b
    $ Any -> Capture Any
    forall ann. Any -> Capture ann
    Value Any
    x
                   | Bool
    otherwise -> do
                [Capture Any]
    cs <- (Any -> IO (Capture Any)) -> [Any] -> IO [Capture Any]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Any -> IO (Capture Any)
    force ([Any] -> IO [Capture Any]) -> [Any] -> IO [Capture Any]
    forall a b. (a -> b) -> a -> b
    $ Any -> [Any]
    children Any
    x
                Capture Any -> IO (Capture Any)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Capture Any -> IO (Capture Any))
    -> Capture Any -> IO (Capture Any)
    forall a b. (a -> b) -> a -> b
    $ Capture Any -> Capture Any
    f (Capture Any -> Capture Any) -> Capture Any -> Capture Any
    forall a b. (a -> b) -> a -> b
    $ Any -> [Capture Any] -> Capture Any
    forall ann. Any -> [Capture ann] -> Capture ann
    Ctor Any
    x [Capture Any]
    cs

    -- | Add an annotation to a value.
    --
    --   It is recommended that anyone making use of this function redefine
    --   it with a more restrictive type signature to control the type of the
    --   annotation (the second argument). Any redefinitions of this function
    --   should add an INLINE pragma, to reduce the chance of incorrect
    --   optimisations.
    {-# INLINE (&=) #-}
    (&=) :: (Data val, Data ann) => val -> ann -> val
    &= :: forall val ann. (Data val, Data ann) => val -> ann -> val
    (&=) val
    x ann
    y = val -> ann -> val
    forall val ann. (Data val, Data ann) => val -> ann -> val
    addAnn (val -> val
    forall a. a -> a
    id_ val
    x) (ann -> ann
    forall a. a -> a
    id_ ann
    y)

    {-# INLINE id_ #-}
    id_ :: a -> a
    id_ :: forall a. a -> a
    id_ a
    x = case ()
    unit of () -> a
    x
        where unit :: ()
    unit = ShowS
    forall a. [a] -> [a]
    reverse String
    "" String -> () -> ()
    forall a b. a -> b -> b
    `seq` ()

    ---------------------------------------------------------------------
    -- PURE PART

    -- | This type represents an annotated value. The type of the underlying value is not specified.
    data Annotate ann
        = forall c f . (Data c, Data f) => (c -> f) := f -- ^ Construct a field, @fieldname := value@.
        | forall c f . (Data c, Data f) => (c -> f) :=+ [Annotate ann] -- ^ Add annotations to a field.
        | AAnn ann (Annotate ann)
        | AMany [Annotate ann]
        | AAtom Any
        | ACtor Any [Annotate ann]
          deriving Typeable
          -- specifically DOES NOT derive Data, to avoid people accidentally including it

    -- | Add an annotation to a value.
    (+=) :: Annotate ann -> ann -> Annotate ann
    += :: forall ann. Annotate ann -> ann -> Annotate ann
    (+=) = (ann -> Annotate ann -> Annotate ann)
    -> Annotate ann -> ann -> Annotate ann
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ann -> Annotate ann -> Annotate ann
    forall ann. ann -> Annotate ann -> Annotate ann
    AAnn

    -- | Collapse many annotated values in to one.
    many_ :: [Annotate a] -> Annotate a
    many_ :: forall a. [Annotate a] -> Annotate a
    many_ = [Annotate a] -> Annotate a
    forall a. [Annotate a] -> Annotate a
    AMany

    -- | Lift a pure value to an annotation.
    atom :: Data val => val -> Annotate ann
    atom :: forall val ann. Data val => val -> Annotate ann
    atom = Any -> Annotate ann
    forall ann. Any -> Annotate ann
    AAtom (Any -> Annotate ann) -> (val -> Any) -> val -> Annotate ann
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . val -> Any
    forall a. Data a => a -> Any
    Any

    -- | Create a constructor/record. The first argument should be
    --   the type of field, the second should be a list of fields constructed
    --   originally defined by @:=@ or @:=+@.
    --
    --   This operation is not type safe, and may raise an exception at runtime
    --   if any field has the wrong type or label.
    record :: Data a => a -> [Annotate ann] -> Annotate ann
    record :: forall a ann. Data a => a -> [Annotate ann] -> Annotate ann
    record a
    a [Annotate ann]
    b = Any -> [Annotate ann] -> Annotate ann
    forall ann. Any -> [Annotate ann] -> Annotate ann
    ACtor (a -> Any
    forall a. Data a => a -> Any
    Any a
    a) [Annotate ann]
    b

    -- | Capture the annotations from an annotated value.
    capture_ :: Show a => Annotate a -> Capture a
    capture_ :: forall a. Show a => Annotate a -> Capture a
    capture_ (AAnn a
    a Annotate a
    x) = a -> Capture a -> Capture a
    forall ann. ann -> Capture ann -> Capture ann
    Ann a
    a (Annotate a -> Capture a
    forall a. Show a => Annotate a -> Capture a
    capture_ Annotate a
    x)
    capture_ (AMany [Annotate a]
    xs) = [Capture a] -> Capture a
    forall ann. [Capture ann] -> Capture ann
    Many ((Annotate a -> Capture a) -> [Annotate a] -> [Capture a]
    forall a b. (a -> b) -> [a] -> [b]
    map Annotate a -> Capture a
    forall a. Show a => Annotate a -> Capture a
    capture_ [Annotate a]
    xs)
    capture_ (AAtom Any
    x) = Any -> Capture a
    forall ann. Any -> Capture ann
    Value Any
    x
    capture_ (c -> f
    _ := f
    c) = Any -> Capture a
    forall ann. Any -> Capture ann
    Value (Any -> Capture a) -> Any -> Capture a
    forall a b. (a -> b) -> a -> b
    $ f -> Any
    forall a. Data a => a -> Any
    Any f
    c
    capture_ (c -> f
    _ :=+ [Annotate a]
    c) = [Capture a] -> Capture a
    forall ann. [Capture ann] -> Capture ann
    Many ([Capture a] -> Capture a) -> [Capture a] -> Capture a
    forall a b. (a -> b) -> a -> b
    $ (Annotate a -> Capture a) -> [Annotate a] -> [Capture a]
    forall a b. (a -> b) -> [a] -> [b]
    map Annotate a -> Capture a
    forall a. Show a => Annotate a -> Capture a
    capture_ [Annotate a]
    c
    capture_ (ACtor Any
    x [Annotate a]
    xs)
        | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Int] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Int]
    rep = String -> Capture a
    forall a. HasCallStack => String -> a
    error (String -> Capture a) -> String -> Capture a
    forall a b. (a -> b) -> a -> b
    $ String
    "Some fields got repeated under " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show Any
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    ctor Any
    x String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ": " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Int] -> String
    forall a. Show a => a -> String
    show [Int]
    rep
        | Bool
    otherwise = Any -> [Capture a] -> Capture a
    forall ann. Any -> [Capture ann] -> Capture ann
    Ctor Any
    x2 [Capture a]
    xs2
        where
            x2 :: Any
    x2 = Any -> [Any] -> Any
    recompose Any
    x ([Any] -> Any) -> [Any] -> Any
    forall a b. (a -> b) -> a -> b
    $ (Capture a -> Any) -> [Capture a] -> [Any]
    forall a b. (a -> b) -> [a] -> [b]
    map Capture a -> Any
    forall ann. Capture ann -> Any
    fromCapture [Capture a]
    xs2
            xs2 :: [Capture a]
    xs2 = [Capture a -> Maybe (Capture a) -> Capture a
    forall a. a -> Maybe a -> a
    fromMaybe (Any -> Capture a
    forall ann. Any -> Capture ann
    Missing Any
    c) (Maybe (Capture a) -> Capture a) -> Maybe (Capture a) -> Capture a
    forall a b. (a -> b) -> a -> b
    $ Int -> [(Int, Capture a)] -> Maybe (Capture a)
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Int
    i [(Int, Capture a)]
    is | let is :: [(Int, Capture a)]
    is = [Int] -> [Capture a] -> [(Int, Capture a)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int]
    inds ([Capture a] -> [(Int, Capture a)])
    -> [Capture a] -> [(Int, Capture a)]
    forall a b. (a -> b) -> a -> b
    $ (Annotate a -> Capture a) -> [Annotate a] -> [Capture a]
    forall a b. (a -> b) -> [a] -> [b]
    map Annotate a -> Capture a
    forall a. Show a => Annotate a -> Capture a
    capture_ [Annotate a]
    xs, (Int
    i,Any
    c) <- [Int] -> [Any] -> [(Int, Any)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] ([Any] -> [(Int, Any)]) -> [Any] -> [(Int, Any)]
    forall a b. (a -> b) -> a -> b
    $ Any -> [Any]
    children Any
    x]
            inds :: [Int]
    inds = (Int -> Maybe Int -> Int) -> [Int] -> [Maybe Int] -> [Int]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe [Int
    0..] ([Maybe Int] -> [Int]) -> [Maybe Int] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ (Annotate a -> Maybe Int) -> [Annotate a] -> [Maybe Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (Any -> Annotate a -> Maybe Int
    forall a. Any -> Annotate a -> Maybe Int
    fieldIndex Any
    x) [Annotate a]
    xs
            rep :: [Int]
    rep = [Int]
    inds [Int] -> [Int] -> [Int]
    forall a. Eq a => [a] -> [a] -> [a]
    \\ [Int] -> [Int]
    forall a. Eq a => [a] -> [a]
    nub [Int]
    inds

    fieldIndex :: Any -> Annotate a -> Maybe Int
    fieldIndex :: forall a. Any -> Annotate a -> Maybe Int
    fieldIndex Any
    ctor (AAnn a
    a Annotate a
    x) = Any -> Annotate a -> Maybe Int
    forall a. Any -> Annotate a -> Maybe Int
    fieldIndex Any
    ctor Annotate a
    x
    fieldIndex Any
    ctor (c -> f
    f := f
    _) = Any -> Annotate Any -> Maybe Int
    forall a. Any -> Annotate a -> Maybe Int
    fieldIndex Any
    ctor (c -> f
    f (c -> f) -> [Annotate Any] -> Annotate Any
    forall ann c f.
    (Data c, Data f) =>
    (c -> f) -> [Annotate ann] -> Annotate ann
    :=+ [])
    fieldIndex Any
    ctor (c -> f
    f :=+ [Annotate a]
    _) | Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe Int
    res = Maybe Int
    res
                              | Bool
    otherwise = String -> Maybe Int
    forall a. HasCallStack => String -> a
    error (String -> Maybe Int) -> String -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ String
    "Couldn't resolve field for " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show Any
    ctor
        where c :: Any
    c = Any -> [Any] -> Any
    recompose Any
    ctor [a -> Any
    forall a. Data a => a -> Any
    Any (a -> Any) -> a -> Any
    forall a b. (a -> b) -> a -> b
    $ Int -> a
    forall a. Int -> a
    throwInt Int
    i a -> a -> a
    forall a. a -> a -> a
    `asTypeOf` a
    x | (Int
    i,Any a
    x) <- [Int] -> [Any] -> [(Int, Any)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] (Any -> [Any]
    children Any
    ctor)]
              res :: Maybe Int
    res = f -> Maybe Int
    forall a. a -> Maybe Int
    catchInt (f -> Maybe Int) -> f -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ c -> f
    f (c -> f) -> c -> f
    forall a b. (a -> b) -> a -> b
    $ Any -> c
    forall a. Typeable a => Any -> a
    fromAny Any
    c
    fieldIndex Any
    _ Annotate a
    _ = Maybe Int
    forall a. Maybe a
    Nothing

    data ExceptionInt = ExceptionInt Int deriving (Int -> ExceptionInt -> ShowS
    [ExceptionInt] -> ShowS
    ExceptionInt -> String
    (Int -> ExceptionInt -> ShowS)
    -> (ExceptionInt -> String)
    -> ([ExceptionInt] -> ShowS)
    -> Show ExceptionInt
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ExceptionInt -> ShowS
    showsPrec :: Int -> ExceptionInt -> ShowS
    $cshow :: ExceptionInt -> String
    show :: ExceptionInt -> String
    $cshowList :: [ExceptionInt] -> ShowS
    showList :: [ExceptionInt] -> ShowS
    Show, Typeable)
    instance Exception ExceptionInt

    throwInt :: Int -> a
    throwInt :: forall a. Int -> a
    throwInt Int
    i = ExceptionInt -> a
    forall a e. Exception e => e -> a
    throw (Int -> ExceptionInt
    ExceptionInt Int
    i)

    {-# NOINLINE catchInt #-}
    catchInt :: a -> Maybe Int
    catchInt :: forall a. a -> Maybe Int
    catchInt a
    x = IO (Maybe Int) -> Maybe Int
    forall a. IO a -> a
    unsafePerformIO (IO (Maybe Int) -> Maybe Int) -> IO (Maybe Int) -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ do
        Either ExceptionInt a
    y <- IO a -> IO (Either ExceptionInt a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (a -> IO a
    forall a. a -> IO a
    evaluate a
    x)
        Maybe Int -> IO (Maybe Int)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Int -> IO (Maybe Int)) -> Maybe Int -> IO (Maybe Int)
    forall a b. (a -> b) -> a -> b
    $ case Either ExceptionInt a
    y of
            Left (ExceptionInt Int
    z) -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just Int
    z
            Either ExceptionInt a
    _ -> Maybe Int
    forall a. Maybe a
    Nothing