    {-# LANGUAGE ExistentialQuantification #-}

    module Data.Generics.Any where

    import Control.Exception
    import Control.Monad.Trans.State
    import qualified Data.Data as D
    import Data.Data hiding (toConstr, typeOf, dataTypeOf)
    import Data.List
    import Data.Maybe
    import System.IO.Unsafe

    type CtorName = String
    type FieldName = String

    readTupleType :: String -> Maybe Int
    readTupleType :: String -> Maybe Int
    readTupleType x :: String
    x | "(" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    x Bool -> Bool -> Bool
    && ")" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    x Bool -> Bool -> Bool
    && (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ',') String
    y = Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> Int -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    y
                    | Bool
    otherwise = Maybe Int
    forall a. Maybe a
    Nothing
        where y :: String
    y = String -> String
    forall a. [a] -> [a]
    init (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    tail String
    x

    try1 :: a -> Either SomeException a
    try1 :: a -> Either SomeException a
    try1 = IO (Either SomeException a) -> Either SomeException a
    forall a. IO a -> a
    unsafePerformIO (IO (Either SomeException a) -> Either SomeException a)
    -> (a -> IO (Either SomeException a))
    -> a
    -> Either SomeException a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO a -> IO (Either SomeException a))
    -> (a -> IO a) -> a -> IO (Either SomeException a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> IO a
    forall a. a -> IO a
    evaluate

    ---------------------------------------------------------------------
    -- BASIC TYPES

    -- | Any value, with a Data dictionary.
    data Any = forall a . Data a => Any a

    type AnyT t = Any

    instance Show Any where
        show :: Any -> String
    show = TypeRep -> String
    forall a. Show a => a -> String
    show (TypeRep -> String) -> (Any -> TypeRep) -> Any -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> TypeRep
    typeOf

    fromAny :: Typeable a => Any -> a
    fromAny :: Any -> a
    fromAny (Any x :: a
    x) = case a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    D.cast a
    x of
        Just y :: a
    y -> a
    y
        ~(Just y :: a
    y) -> String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ "Data.Generics.Any.fromAny: Failed to extract any, got " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                             TypeRep -> String
    forall a. Show a => a -> String
    show (a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    D.typeOf a
    x) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ", wanted " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TypeRep -> String
    forall a. Show a => a -> String
    show (a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    D.typeOf a
    y)

    cast :: Typeable a => Any -> Maybe a
    cast :: Any -> Maybe a
    cast (Any x :: a
    x) = a -> Maybe a
    forall a b. (Typeable a, Typeable b) => a -> Maybe b
    D.cast a
    x

    ---------------------------------------------------------------------
    -- SYB COMPATIBILITY

    toConstr :: Any -> Constr
    toConstr :: Any -> Constr
    toConstr (Any x :: a
    x) = a -> Constr
    forall a. Data a => a -> Constr
    D.toConstr a
    x

    typeOf :: Any -> TypeRep
    typeOf :: Any -> TypeRep
    typeOf (Any x :: a
    x) = a -> TypeRep
    forall a. Typeable a => a -> TypeRep
    D.typeOf a
    x

    dataTypeOf :: Any -> DataType
    dataTypeOf :: Any -> DataType
    dataTypeOf (Any x :: a
    x) = a -> DataType
    forall a. Data a => a -> DataType
    D.dataTypeOf a
    x

    isAlgType :: Any -> Bool
    isAlgType :: Any -> Bool
    isAlgType = DataType -> Bool
    D.isAlgType (DataType -> Bool) -> (Any -> DataType) -> Any -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> DataType
    dataTypeOf

    ---------------------------------------------------------------------
    -- TYPE STUFF

    typeShell :: Any -> String
    typeShell :: Any -> String
    typeShell = String -> String
    tyconUQname (String -> String) -> (Any -> String) -> Any -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> String
    typeShellFull

    typeShellFull :: Any -> String
    typeShellFull :: Any -> String
    typeShellFull = TyCon -> String
    tyConName (TyCon -> String) -> (Any -> TyCon) -> Any -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TypeRep -> TyCon
    typeRepTyCon (TypeRep -> TyCon) -> (Any -> TypeRep) -> Any -> TyCon
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> TypeRep
    typeOf

    typeName :: Any -> String
    typeName :: Any -> String
    typeName = TypeRep -> String
    forall a. Show a => a -> String
    show (TypeRep -> String) -> (Any -> TypeRep) -> Any -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> TypeRep
    typeOf

    ---------------------------------------------------------------------
    -- ANY PRIMITIVES

    ctor :: Any -> CtorName
    ctor :: Any -> String
    ctor = Constr -> String
    showConstr (Constr -> String) -> (Any -> Constr) -> Any -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Constr
    toConstr

    fields :: Any -> [String]
    fields :: Any -> [String]
    fields = Constr -> [String]
    constrFields (Constr -> [String]) -> (Any -> Constr) -> Any -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> Constr
    toConstr

    children :: Any -> [Any]
    children :: Any -> [Any]
    children (Any x :: a
    x) = (forall d. Data d => d -> Any) -> a -> [Any]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ forall d. Data d => d -> Any
    Any a
    x

    compose0 :: Any -> CtorName -> Any
    compose0 :: Any -> String -> Any
    compose0 x :: Any
    x c :: String
    c | (SomeException -> Bool)
    -> (String -> Bool) -> Either SomeException String -> Bool
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (Bool -> SomeException -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    c) (Either SomeException String -> Bool)
    -> Either SomeException String -> Bool
    forall a b. (a -> b) -> a -> b
    $ String -> Either SomeException String
    forall a. a -> Either SomeException a
    try1 (String -> Either SomeException String)
    -> String -> Either SomeException String
    forall a b. (a -> b) -> a -> b
    $ Any -> String
    ctor Any
    x = Any
    x
    compose0 (Any x :: a
    x) c :: String
    c = a -> Any
    forall d. Data d => d -> Any
    Any (a -> Any) -> a -> Any
    forall a b. (a -> b) -> a -> b
    $ (forall d. Data d => d) -> Constr -> a
    forall a. Data a => (forall d. Data d => d) -> Constr -> a
    fromConstrB forall a. a
    forall d. Data d => d
    err Constr
    y a -> a -> a
    forall a. a -> a -> a
    `asTypeOf` a
    x
        where Just y :: Constr
    y = DataType -> String -> Maybe Constr
    readConstr (a -> DataType
    forall a. Data a => a -> DataType
    D.dataTypeOf a
    x) String
    c
              err :: a
    err = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ "Data.Generics.Any: Undefined field inside compose0, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show (a -> Any
    forall d. Data d => d -> Any
    Any a
    x)

    recompose :: Any -> [Any] -> Any
    recompose :: Any -> [Any] -> Any
    recompose (Any x :: a
    x) cs :: [Any]
    cs | [Any] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Any]
    s = a -> Any
    forall d. Data d => d -> Any
    Any (a -> Any) -> a -> Any
    forall a b. (a -> b) -> a -> b
    $ a
    res a -> a -> a
    forall a. a -> a -> a
    `asTypeOf` a
    x
                         | Bool
    otherwise = Any
    forall a. a
    err
        where (res :: a
    res,s :: [Any]
    s) = State [Any] a -> [Any] -> (a, [Any])
    forall s a. State s a -> s -> (a, s)
    runState ((forall d. Data d => StateT [Any] Identity d)
    -> Constr -> State [Any] a
    forall (m :: * -> *) a.
    (Monad m, Data a) =>
    (forall d. Data d => m d) -> Constr -> m a
    fromConstrM forall d. Data d => StateT [Any] Identity d
    field (Constr -> State [Any] a) -> Constr -> State [Any] a
    forall a b. (a -> b) -> a -> b
    $ a -> Constr
    forall a. Data a => a -> Constr
    D.toConstr a
    x) [Any]
    cs

              field :: Data d => State [Any] d
              field :: State [Any] d
    field = do [Any]
    cs <- StateT [Any] Identity [Any]
    forall (m :: * -> *) s. Monad m => StateT s m s
    get
                         if [Any] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Any]
    cs then State [Any] d
    forall a. a
    err else do
                             [Any] -> StateT [Any] Identity ()
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
    put ([Any] -> StateT [Any] Identity ())
    -> [Any] -> StateT [Any] Identity ()
    forall a b. (a -> b) -> a -> b
    $ [Any] -> [Any]
    forall a. [a] -> [a]
    tail [Any]
    cs
                             d -> State [Any] d
    forall (m :: * -> *) a. Monad m => a -> m a
    return (d -> State [Any] d) -> d -> State [Any] d
    forall a b. (a -> b) -> a -> b
    $ Any -> d
    forall a. Typeable a => Any -> a
    fromAny (Any -> d) -> Any -> d
    forall a b. (a -> b) -> a -> b
    $ [Any] -> Any
    forall a. [a] -> a
    head [Any]
    cs

              err :: a
    err = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ "Data.Generics.Any.recompose: Incorrect number of children to recompose, " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                            Any -> String
    ctor (a -> Any
    forall d. Data d => d -> Any
    Any a
    x) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " :: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Any -> String
    forall a. Show a => a -> String
    show (a -> Any
    forall d. Data d => d -> Any
    Any a
    x) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ", expected " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show (Any -> Int
    arity (Any -> Int) -> Any -> Int
    forall a b. (a -> b) -> a -> b
    $ a -> Any
    forall d. Data d => d -> Any
    Any a
    x) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                            ", got " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show ([Any] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Any]
    cs)

    ctors :: Any -> [CtorName]
    ctors :: Any -> [String]
    ctors = (Constr -> String) -> [Constr] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Constr -> String
    showConstr ([Constr] -> [String]) -> (Any -> [Constr]) -> Any -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DataType -> [Constr]
    dataTypeConstrs (DataType -> [Constr]) -> (Any -> DataType) -> Any -> [Constr]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> DataType
    dataTypeOf

    ---------------------------------------------------------------------
    -- DERIVED FUNCTIONS

    decompose :: Any -> (CtorName,[Any])
    decompose :: Any -> (String, [Any])
    decompose x :: Any
    x = (Any -> String
    ctor Any
    x, Any -> [Any]
    children Any
    x)

    arity :: Any -> Int
    arity = [Any] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([Any] -> Int) -> (Any -> [Any]) -> Any -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Any -> [Any]
    children

    compose :: Any -> CtorName -> [Any] -> Any
    compose :: Any -> String -> [Any] -> Any
    compose t :: Any
    t c :: String
    c xs :: [Any]
    xs = Any -> [Any] -> Any
    recompose (Any -> String -> Any
    compose0 Any
    t String
    c) [Any]
    xs

    ---------------------------------------------------------------------
    -- FIELD UTILITIES

    getField :: FieldName -> Any -> Any
    getField :: String -> Any -> Any
    getField lbl :: String
    lbl x :: Any
    x = Any -> Maybe Any -> Any
    forall a. a -> Maybe a -> a
    fromMaybe (String -> Any
    forall a. HasCallStack => String -> a
    error (String -> Any) -> String -> Any
    forall a b. (a -> b) -> a -> b
    $ "getField: Could not find field " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    lbl) (Maybe Any -> Any) -> Maybe Any -> Any
    forall a b. (a -> b) -> a -> b
    $
        String -> [(String, Any)] -> Maybe Any
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    lbl ([(String, Any)] -> Maybe Any) -> [(String, Any)] -> Maybe Any
    forall a b. (a -> b) -> a -> b
    $ [String] -> [Any] -> [(String, Any)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (Any -> [String]
    fields Any
    x) (Any -> [Any]
    children Any
    x)

    setField :: (FieldName,Any) -> Any -> Any
    setField :: (String, Any) -> Any -> Any
    setField (lbl :: String
    lbl,child :: Any
    child) parent :: Any
    parent
        | String
    lbl String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [String]
    fs = String -> Any
    forall a. HasCallStack => String -> a
    error (String -> Any) -> String -> Any
    forall a b. (a -> b) -> a -> b
    $ "setField: Could not find field " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    lbl
        | Bool
    otherwise = Any -> [Any] -> Any
    recompose Any
    parent ([Any] -> Any) -> [Any] -> Any
    forall a b. (a -> b) -> a -> b
    $ (String -> Any -> Any) -> [String] -> [Any] -> [Any]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (\f :: String
    f c :: Any
    c -> if String
    f String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    lbl then Any
    child else Any
    c) [String]
    fs [Any]
    cs
        where
            fs :: [String]
    fs = Any -> [String]
    fields Any
    parent
            cs :: [Any]
    cs = Any -> [Any]
    children Any
    parent