    {-# LANGUAGE OverloadedStrings #-}

    module DBus.Introspection.Parse
        ( parseXML
        ) where

    import Conduit
    import Data.Maybe
    import Data.XML.Types
    import qualified Data.Text as T
    import qualified Text.XML.Stream.Parse as X

    import DBus.Internal.Types
    import DBus.Introspection.Types

    data ObjectChildren
        = InterfaceDefinition Interface
        | SubNode Object

    data InterfaceChildren
        = MethodDefinition Method
        | SignalDefinition Signal
        | PropertyDefinition Property

    parseXML :: ObjectPath -> T.Text -> Maybe Object
    parseXML :: ObjectPath -> Text -> Maybe Object
    parseXML ObjectPath
    path Text
    xml =
        ConduitT () Void Maybe Object -> Maybe Object
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void Maybe Object -> Maybe Object)
    -> ConduitT () Void Maybe Object -> Maybe Object
    forall a b. (a -> b) -> a -> b
    $ [Text] -> ConduitT () (Element [Text]) Maybe ()
    forall (m :: * -> *) mono i.
    (Monad m, MonoFoldable mono) =>
    mono -> ConduitT i (Element mono) m ()
    yieldMany [Text
    xml] ConduitT () Text Maybe ()
    -> ConduitT Text Void Maybe Object -> ConduitT () Void Maybe Object
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ParseSettings -> ConduitT Text Event Maybe ()
    forall (m :: * -> *).
    MonadThrow m =>
    ParseSettings -> ConduitT Text Event m ()
    X.parseText ParseSettings
    forall a. Default a => a
    X.def ConduitT Text Event Maybe ()
    -> ConduitT Event Void Maybe Object
    -> ConduitT Text Void Maybe Object
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| String
    -> ConduitT Event Void Maybe (Maybe Object)
    -> ConduitT Event Void Maybe Object
    forall (m :: * -> *) a.
    MonadThrow m =>
    String -> m (Maybe a) -> m a
    X.force String
    "parse error" (AttrParser ObjectPath -> ConduitT Event Void Maybe (Maybe Object)
    forall o.
    AttrParser ObjectPath -> ConduitT Event o Maybe (Maybe Object)
    parseObject (AttrParser ObjectPath -> ConduitT Event Void Maybe (Maybe Object))
    -> AttrParser ObjectPath
    -> ConduitT Event Void Maybe (Maybe Object)
    forall a b. (a -> b) -> a -> b
    $ ObjectPath -> AttrParser ObjectPath
    getRootName ObjectPath
    path)

    getRootName :: ObjectPath -> X.AttrParser ObjectPath
    getRootName :: ObjectPath -> AttrParser ObjectPath
    getRootName ObjectPath
    defaultPath = do
        nodeName <- Name -> AttrParser (Maybe Text)
    X.attr Name
    "name"
        pure $ maybe defaultPath (objectPath_ . T.unpack) nodeName

    getChildName :: ObjectPath -> X.AttrParser ObjectPath
    getChildName :: ObjectPath -> AttrParser ObjectPath
    getChildName ObjectPath
    parentPath = do
        nodeName <- Name -> AttrParser Text
    X.requireAttr Name
    "name"
        let parentPath' = case ObjectPath -> String
    formatObjectPath ObjectPath
    parentPath of
                String
    "/" -> String
    "/"
                String
    x   -> String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "/"
        pure $ objectPath_ (parentPath' ++ T.unpack nodeName)

    parseObject
        :: X.AttrParser ObjectPath
        -> ConduitT Event o Maybe (Maybe Object)
    parseObject :: forall o.
    AttrParser ObjectPath -> ConduitT Event o Maybe (Maybe Object)
    parseObject AttrParser ObjectPath
    getPath = NameMatcher Name
    -> AttrParser ObjectPath
    -> (ObjectPath -> ConduitT Event o Maybe Object)
    -> ConduitT Event o Maybe (Maybe Object)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "node" AttrParser ObjectPath
    getPath ObjectPath -> ConduitT Event o Maybe Object
    forall {o}. ObjectPath -> ConduitT Event o Maybe Object
    parseContent
      where
        parseContent :: ObjectPath -> ConduitT Event o Maybe Object
    parseContent ObjectPath
    objPath = do
            elems <- ConduitT Event o Maybe (Maybe ObjectChildren)
    -> ConduitT Event o Maybe [ObjectChildren]
    forall (m :: * -> *) o a.
    Monad m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
    X.many (ConduitT Event o Maybe (Maybe ObjectChildren)
     -> ConduitT Event o Maybe [ObjectChildren])
    -> ConduitT Event o Maybe (Maybe ObjectChildren)
    -> ConduitT Event o Maybe [ObjectChildren]
    forall a b. (a -> b) -> a -> b
    $ [ConduitT Event o Maybe (Maybe ObjectChildren)]
    -> ConduitT Event o Maybe (Maybe ObjectChildren)
    forall (m :: * -> *) o a.
    Monad m =>
    [ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
    X.choose
                [ (Object -> ObjectChildren) -> Maybe Object -> Maybe ObjectChildren
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Object -> ObjectChildren
    SubNode (Maybe Object -> Maybe ObjectChildren)
    -> ConduitT Event o Maybe (Maybe Object)
    -> ConduitT Event o Maybe (Maybe ObjectChildren)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> AttrParser ObjectPath -> ConduitT Event o Maybe (Maybe Object)
    forall o.
    AttrParser ObjectPath -> ConduitT Event o Maybe (Maybe Object)
    parseObject (ObjectPath -> AttrParser ObjectPath
    getChildName ObjectPath
    objPath)
                , (Interface -> ObjectChildren)
    -> Maybe Interface -> Maybe ObjectChildren
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Interface -> ObjectChildren
    InterfaceDefinition (Maybe Interface -> Maybe ObjectChildren)
    -> ConduitT Event o Maybe (Maybe Interface)
    -> ConduitT Event o Maybe (Maybe ObjectChildren)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ConduitT Event o Maybe (Maybe Interface)
    forall o. ConduitT Event o Maybe (Maybe Interface)
    parseInterface
                ]
            let base = ObjectPath -> [Interface] -> [Object] -> Object
    Object ObjectPath
    objPath [] []
                addElem ObjectChildren
    e (Object ObjectPath
    p [Interface]
    is [Object]
    cs) = case ObjectChildren
    e of
                    InterfaceDefinition Interface
    i -> ObjectPath -> [Interface] -> [Object] -> Object
    Object ObjectPath
    p (Interface
    iInterface -> [Interface] -> [Interface]
    forall a. a -> [a] -> [a]
    :[Interface]
    is) [Object]
    cs
                    SubNode Object
    c -> ObjectPath -> [Interface] -> [Object] -> Object
    Object ObjectPath
    p [Interface]
    is (Object
    cObject -> [Object] -> [Object]
    forall a. a -> [a] -> [a]
    :[Object]
    cs)
            pure $ foldr addElem base elems

    parseInterface
        :: ConduitT Event o Maybe (Maybe Interface)
    parseInterface :: forall o. ConduitT Event o Maybe (Maybe Interface)
    parseInterface = NameMatcher Name
    -> AttrParser InterfaceName
    -> (InterfaceName -> ConduitT Event o Maybe Interface)
    -> ConduitT Event o Maybe (Maybe Interface)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "interface" AttrParser InterfaceName
    getName InterfaceName -> ConduitT Event o Maybe Interface
    forall {o}. InterfaceName -> ConduitT Event o Maybe Interface
    parseContent
      where
        getName :: AttrParser InterfaceName
    getName = do
            ifName <- Name -> AttrParser Text
    X.requireAttr Name
    "name"
            pure $ interfaceName_ (T.unpack ifName)
        parseContent :: InterfaceName -> ConduitT Event o Maybe Interface
    parseContent InterfaceName
    ifName = do
            elems <- ConduitT Event o Maybe (Maybe InterfaceChildren)
    -> ConduitT Event o Maybe [InterfaceChildren]
    forall (m :: * -> *) o a.
    Monad m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
    X.many (ConduitT Event o Maybe (Maybe InterfaceChildren)
     -> ConduitT Event o Maybe [InterfaceChildren])
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    -> ConduitT Event o Maybe [InterfaceChildren]
    forall a b. (a -> b) -> a -> b
    $ do
                ConduitT Event o Maybe (Maybe ()) -> ConduitT Event o Maybe ()
    forall (m :: * -> *) o a.
    MonadThrow m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m ()
    X.many_ (ConduitT Event o Maybe (Maybe ()) -> ConduitT Event o Maybe ())
    -> ConduitT Event o Maybe (Maybe ()) -> ConduitT Event o Maybe ()
    forall a b. (a -> b) -> a -> b
    $ NameMatcher Name
    -> AttrParser () -> ConduitT Event o Maybe (Maybe ())
    forall (m :: * -> *) a b o.
    MonadThrow m =>
    NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
    X.ignoreTreeContent NameMatcher Name
    "annotation" AttrParser ()
    X.ignoreAttrs
                [ConduitT Event o Maybe (Maybe InterfaceChildren)]
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall (m :: * -> *) o a.
    Monad m =>
    [ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
    X.choose
                    [ ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseMethod
                    , ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseSignal
                    , ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseProperty
                    ]
            X.many_ $ X.ignoreTreeContent "annotation" X.ignoreAttrs
            let base = InterfaceName -> [Method] -> [Signal] -> [Property] -> Interface
    Interface InterfaceName
    ifName [] [] []
                addElem InterfaceChildren
    e (Interface InterfaceName
    n [Method]
    ms [Signal]
    ss [Property]
    ps) = case InterfaceChildren
    e of
                    MethodDefinition Method
    m -> InterfaceName -> [Method] -> [Signal] -> [Property] -> Interface
    Interface InterfaceName
    n (Method
    mMethod -> [Method] -> [Method]
    forall a. a -> [a] -> [a]
    :[Method]
    ms) [Signal]
    ss [Property]
    ps
                    SignalDefinition Signal
    s -> InterfaceName -> [Method] -> [Signal] -> [Property] -> Interface
    Interface InterfaceName
    n [Method]
    ms (Signal
    sSignal -> [Signal] -> [Signal]
    forall a. a -> [a] -> [a]
    :[Signal]
    ss) [Property]
    ps
                    PropertyDefinition Property
    p -> InterfaceName -> [Method] -> [Signal] -> [Property] -> Interface
    Interface InterfaceName
    n [Method]
    ms [Signal]
    ss (Property
    pProperty -> [Property] -> [Property]
    forall a. a -> [a] -> [a]
    :[Property]
    ps)
            pure $ foldr addElem base elems

    parseMethod :: ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseMethod :: forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseMethod = NameMatcher Name
    -> AttrParser MemberName
    -> (MemberName -> ConduitT Event o Maybe InterfaceChildren)
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "method" AttrParser MemberName
    getName MemberName -> ConduitT Event o Maybe InterfaceChildren
    forall {m :: * -> *} {o}.
    MonadThrow m =>
    MemberName -> ConduitT Event o m InterfaceChildren
    parseArgs
      where
        getName :: AttrParser MemberName
    getName = do
            ifName <- Name -> AttrParser Text
    X.requireAttr Name
    "name"
            parseMemberName (T.unpack ifName)
        parseArgs :: MemberName -> ConduitT Event o m InterfaceChildren
    parseArgs MemberName
    name = do
            args <- ConduitT Event o m (Maybe MethodArg)
    -> ConduitT Event o m [MethodArg]
    forall (m :: * -> *) o a.
    Monad m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
    X.many (ConduitT Event o m (Maybe MethodArg)
     -> ConduitT Event o m [MethodArg])
    -> ConduitT Event o m (Maybe MethodArg)
    -> ConduitT Event o m [MethodArg]
    forall a b. (a -> b) -> a -> b
    $ do
                ConduitT Event o m (Maybe ()) -> ConduitT Event o m ()
    forall (m :: * -> *) o a.
    MonadThrow m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m ()
    X.many_ (ConduitT Event o m (Maybe ()) -> ConduitT Event o m ())
    -> ConduitT Event o m (Maybe ()) -> ConduitT Event o m ()
    forall a b. (a -> b) -> a -> b
    $ NameMatcher Name -> AttrParser () -> ConduitT Event o m (Maybe ())
    forall (m :: * -> *) a b o.
    MonadThrow m =>
    NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
    X.ignoreTreeContent NameMatcher Name
    "annotation" AttrParser ()
    X.ignoreAttrs
                NameMatcher Name
    -> AttrParser MethodArg
    -> (MethodArg -> ConduitT Event o m MethodArg)
    -> ConduitT Event o m (Maybe MethodArg)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "arg" AttrParser MethodArg
    getArg MethodArg -> ConduitT Event o m MethodArg
    forall a. a -> ConduitT Event o m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            X.many_ $ X.ignoreTreeContent "annotation" X.ignoreAttrs
            pure $ MethodDefinition $ Method name args
        getArg :: AttrParser MethodArg
    getArg = do
            name <- Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> AttrParser (Maybe Text) -> AttrParser Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AttrParser (Maybe Text)
    X.attr Name
    "name"
            typeStr <- X.requireAttr "type"
            dirStr <- fromMaybe "in" <$> X.attr "direction"
            X.ignoreAttrs
            typ <- parseType typeStr
            let dir = if Text
    dirStr Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "in" then Direction
    In else Direction
    Out
            pure $ MethodArg (T.unpack name) typ dir

    parseSignal :: ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseSignal :: forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseSignal = NameMatcher Name
    -> AttrParser MemberName
    -> (MemberName -> ConduitT Event o Maybe InterfaceChildren)
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "signal" AttrParser MemberName
    getName MemberName -> ConduitT Event o Maybe InterfaceChildren
    forall {m :: * -> *} {o}.
    MonadThrow m =>
    MemberName -> ConduitT Event o m InterfaceChildren
    parseArgs
      where
        getName :: AttrParser MemberName
    getName = do
            ifName <- Name -> AttrParser Text
    X.requireAttr Name
    "name"
            parseMemberName (T.unpack ifName)
        parseArgs :: MemberName -> ConduitT Event o m InterfaceChildren
    parseArgs MemberName
    name = do
            args <- ConduitT Event o m (Maybe SignalArg)
    -> ConduitT Event o m [SignalArg]
    forall (m :: * -> *) o a.
    Monad m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
    X.many (ConduitT Event o m (Maybe SignalArg)
     -> ConduitT Event o m [SignalArg])
    -> ConduitT Event o m (Maybe SignalArg)
    -> ConduitT Event o m [SignalArg]
    forall a b. (a -> b) -> a -> b
    $ do
                ConduitT Event o m (Maybe ()) -> ConduitT Event o m ()
    forall (m :: * -> *) o a.
    MonadThrow m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m ()
    X.many_ (ConduitT Event o m (Maybe ()) -> ConduitT Event o m ())
    -> ConduitT Event o m (Maybe ()) -> ConduitT Event o m ()
    forall a b. (a -> b) -> a -> b
    $ NameMatcher Name -> AttrParser () -> ConduitT Event o m (Maybe ())
    forall (m :: * -> *) a b o.
    MonadThrow m =>
    NameMatcher a -> AttrParser b -> ConduitT Event o m (Maybe ())
    X.ignoreTreeContent NameMatcher Name
    "annotation" AttrParser ()
    X.ignoreAttrs
                NameMatcher Name
    -> AttrParser SignalArg
    -> (SignalArg -> ConduitT Event o m SignalArg)
    -> ConduitT Event o m (Maybe SignalArg)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "arg" AttrParser SignalArg
    getArg SignalArg -> ConduitT Event o m SignalArg
    forall a. a -> ConduitT Event o m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
            X.many_ $ X.ignoreTreeContent "annotation" X.ignoreAttrs
            pure $ SignalDefinition $ Signal name args
        getArg :: AttrParser SignalArg
    getArg = do
            name <- Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "" (Maybe Text -> Text) -> AttrParser (Maybe Text) -> AttrParser Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AttrParser (Maybe Text)
    X.attr Name
    "name"
            typeStr <- X.requireAttr "type"
            X.ignoreAttrs
            typ <- parseType typeStr
            pure $ SignalArg (T.unpack name) typ

    parseProperty :: ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseProperty :: forall o. ConduitT Event o Maybe (Maybe InterfaceChildren)
    parseProperty = NameMatcher Name
    -> AttrParser InterfaceChildren
    -> (InterfaceChildren -> ConduitT Event o Maybe InterfaceChildren)
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall (m :: * -> *) a b o c.
    MonadThrow m =>
    NameMatcher a
    -> AttrParser b
    -> (b -> ConduitT Event o m c)
    -> ConduitT Event o m (Maybe c)
    X.tag' NameMatcher Name
    "property" AttrParser InterfaceChildren
    getProp ((InterfaceChildren -> ConduitT Event o Maybe InterfaceChildren)
     -> ConduitT Event o Maybe (Maybe InterfaceChildren))
    -> (InterfaceChildren -> ConduitT Event o Maybe InterfaceChildren)
    -> ConduitT Event o Maybe (Maybe InterfaceChildren)
    forall a b. (a -> b) -> a -> b
    $ \InterfaceChildren
    p -> do
        ConduitT Event o Maybe (Maybe ()) -> ConduitT Event o Maybe ()
    forall (m :: * -> *) o a.
    MonadThrow m =>
    ConduitT Event o m (Maybe a) -> ConduitT Event o m ()
    X.many_ ConduitT Event o Maybe (Maybe ())
    forall (m :: * -> *) o.
    MonadThrow m =>
    ConduitT Event o m (Maybe ())
    X.ignoreAnyTreeContent
        InterfaceChildren -> ConduitT Event o Maybe InterfaceChildren
    forall a. a -> ConduitT Event o Maybe a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure InterfaceChildren
    p
      where
        getProp :: AttrParser InterfaceChildren
    getProp = do
            name <- Text -> String
    T.unpack (Text -> String) -> AttrParser Text -> AttrParser String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> AttrParser Text
    X.requireAttr Name
    "name"
            typeStr <- X.requireAttr "type"
            accessStr <- fromMaybe "" <$> X.attr "access"
            X.ignoreAttrs
            typ <- parseType typeStr
            (canRead, canWrite) <- case accessStr of
                Text
    ""          -> (Bool, Bool) -> AttrParser (Bool, Bool)
    forall a. a -> AttrParser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    False, Bool
    False)
                Text
    "read"      -> (Bool, Bool) -> AttrParser (Bool, Bool)
    forall a. a -> AttrParser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    True, Bool
    False)
                Text
    "write"     -> (Bool, Bool) -> AttrParser (Bool, Bool)
    forall a. a -> AttrParser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    False, Bool
    True)
                Text
    "readwrite" -> (Bool, Bool) -> AttrParser (Bool, Bool)
    forall a. a -> AttrParser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Bool
    True, Bool
    True)
                Text
    _           -> IOError -> AttrParser (Bool, Bool)
    forall e a. (HasCallStack, Exception e) => e -> AttrParser a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (IOError -> AttrParser (Bool, Bool))
    -> IOError -> AttrParser (Bool, Bool)
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError String
    "invalid access value"

            pure $ PropertyDefinition $ Property name typ canRead canWrite

    parseType :: MonadThrow m => T.Text -> m Type
    parseType :: forall (m :: * -> *). MonadThrow m => Text -> m Type
    parseType Text
    typeStr = do
        typ <- String -> m Signature
    forall (m :: * -> *). MonadThrow m => String -> m Signature
    parseSignature (Text -> String
    T.unpack Text
    typeStr)
        case signatureTypes typ of
            [Type
    t] -> Type -> m Type
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Type
    t
            [Type]
    _ -> IOError -> m Type
    forall e a. (HasCallStack, Exception e) => e -> m a
    forall (m :: * -> *) e a.
    (MonadThrow m, HasCallStack, Exception e) =>
    e -> m a
    throwM (IOError -> m Type) -> IOError -> m Type
    forall a b. (a -> b) -> a -> b
    $ String -> IOError
    userError String
    "invalid type sig"