module Data.GI.GIR.Alias
    ( documentListAliases
    ) where

import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import Text.XML (Element(elementAttributes), Document(documentRoot))

import Data.GI.GIR.BasicTypes (Alias(..), Type(..), BasicType(..))
import Data.GI.GIR.Type (parseOptionalType)
import Data.GI.GIR.Parser
import Data.GI.GIR.XMLUtils (childElemsWithLocalName)

-- | Find all aliases in a given namespace.
namespaceListAliases :: Element -> M.Map Alias Type
namespaceListAliases :: Element -> Map Alias Type
namespaceListAliases Element
ns =
    case Name -> Map Name ParseError -> Maybe ParseError
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
"name" (Element -> Map Name ParseError
elementAttributes Element
ns) of
      Maybe ParseError
Nothing -> [Char] -> Map Alias Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> Map Alias Type) -> [Char] -> Map Alias Type
forall a b. (a -> b) -> a -> b
$ [Char]
"Namespace with no name!"
      Just ParseError
nsName -> case ParseError
-> Map Alias Type
-> Element
-> Parser [(ParseError, Type)]
-> Either ParseError [(ParseError, Type)]
forall a.
ParseError
-> Map Alias Type -> Element -> Parser a -> Either ParseError a
runParser ParseError
nsName Map Alias Type
forall k a. Map k a
M.empty Element
ns Parser [(ParseError, Type)]
parseAliases of
                       Left ParseError
err -> ([Char] -> Map Alias Type
forall a. HasCallStack => [Char] -> a
error ([Char] -> Map Alias Type)
-> (ParseError -> [Char]) -> ParseError -> Map Alias Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
T.unpack) ParseError
err
                       Right [(ParseError, Type)]
aliases -> [(Alias, Type)] -> Map Alias Type
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (((ParseError, Type) -> (Alias, Type))
-> [(ParseError, Type)] -> [(Alias, Type)]
forall a b. (a -> b) -> [a] -> [b]
map (ParseError, Type) -> (Alias, Type)
forall {b}. (ParseError, b) -> (Alias, b)
addNS [(ParseError, Type)]
aliases)
                           where addNS :: (ParseError, b) -> (Alias, b)
addNS (ParseError
n, b
t) = (Name -> Alias
Alias (ParseError -> ParseError -> Name
Name ParseError
nsName ParseError
n), b
t)

-- | Parse all the aliases in the current namespace
parseAliases :: Parser [(Text, Type)]
parseAliases :: Parser [(ParseError, Type)]
parseAliases = ParseError
-> Parser (ParseError, Type) -> Parser [(ParseError, Type)]
forall a. ParseError -> Parser a -> Parser [a]
parseChildrenWithLocalName ParseError
"alias" Parser (ParseError, Type)
parseAlias

-- | Parse a single alias
parseAlias :: Parser (Text, Type)
parseAlias :: Parser (ParseError, Type)
parseAlias = do
  ParseError
name <- Name -> Parser ParseError
getAttr Name
"name"
  Maybe Type
t <- Parser (Maybe Type)
parseOptionalType
  (ParseError, Type) -> Parser (ParseError, Type)
forall a. a -> ReaderT ParseContext (Except ParseError) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ParseError
name, Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe (BasicType -> Type
TBasicType BasicType
TPtr) Maybe Type
t)

-- | Find all aliases in a given document.
documentListAliases :: Document -> M.Map Alias Type
documentListAliases :: Document -> Map Alias Type
documentListAliases Document
doc = [Map Alias Type] -> Map Alias Type
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ((Element -> Map Alias Type) -> [Element] -> [Map Alias Type]
forall a b. (a -> b) -> [a] -> [b]
map Element -> Map Alias Type
namespaceListAliases [Element]
namespaces)
    where namespaces :: [Element]
namespaces = ParseError -> Element -> [Element]
childElemsWithLocalName ParseError
"namespace" (Document -> Element
documentRoot Document
doc)