925b3e6 · typeable/xsd-parser

git.iko.soy/typeable/xsd-parser

on master help sign in

Account to top-level complex types

925b3e6Denis Redozubov7 years ago

src/Text/XSD/Internal.hs+8−3

compare with master

unifiedsplit

@@ -1,3 +1,4 @@

1+{-# LANGUAGE OverloadedStrings #-}

1{-# LANGUAGE TemplateHaskell #-}

2{-# LANGUAGE TemplateHaskell #-}

3-- | A subset of XSD specification.

4-- | A subset of XSD specification.

@@ -171,10 +172,14 @@ type QName = (Maybe Namespace, LocalName)

171-- deriving (Show)

172-- deriving (Show)

172

173

173data Element = Element

174data Element = Element

174− { name :: QName

175+ { name :: !QName

175− , xtype :: DatatypeRef

176+ , xtype :: !DatatypeRef

177+ , minOccurs :: !Int

178+ , maxOccurs :: !(Maybe Int)

176 } deriving (Show, Eq)

179 } deriving (Show, Eq)

177

180

181+type DatatypeMap = M.Map Text Datatype

182+

178-- | Embodies an XSD document

183-- | Embodies an XSD document

179−newtype XSD = XSD { unXSD :: [Element] }

184+newtype XSD = XSD { unXSD :: ([Element], DatatypeMap) }

180 deriving (Show, Eq)

185 deriving (Show, Eq)

src/Text/XSD/Parser.hs+20−13

@@ -1,3 +1,6 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE OverloadedStrings #-}

1module Text.XSD.Parser where

4module Text.XSD.Parser where

3import Control.Exception

6import Control.Exception

@@ -23,10 +26,10 @@ newtype XSDException = XSDException String

24instance Exception XSDException

27instance Exception XSDException

26−type XSDMonad a = WriterT (M.Map Text Datatype) (Either SomeException) a

29+type XSDMonad a = WriterT DatatypeMap (Either SomeException) a

28parseXSD :: ParseSettings -> ByteString -> Either SomeException XSD

31parseXSD :: ParseSettings -> ByteString -> Either SomeException XSD

29−parseXSD ps bs = parseLBS ps bs >>= fmap fst . toXsd

32+parseXSD ps bs = parseLBS ps bs >>= toXsd

31-- Show is Meh

34-- Show is Meh

32throwXsd :: Show s => s -> XSDMonad a

35throwXsd :: Show s => s -> XSDMonad a

@@ -51,13 +54,6 @@ toElemsAndDatatypes cursor = do

51 throwXsd $ "unnamed type ref for datatype: " <> show datatype

54 throwXsd $ "unnamed type ref for datatype: " <> show datatype

52 pure elems

55 pure elems

54−toSchema :: XML.Cursor -> XSDMonad XSD

55−toSchema cursor = do

56− let topLevel = cursor $| laxElement "schema"

57− if P.null topLevel

58− then throwXsd "Top-level schema definition not found"

59− else XSD <$> toElemsAndDatatypes cursor

60−

61safeHead :: [a] -> Maybe a

57safeHead :: [a] -> Maybe a

62safeHead [] = Nothing

58safeHead [] = Nothing

63safeHead (a:_) = Just a

59safeHead (a:_) = Just a

@@ -74,6 +70,9 @@ toElem cursor = do

74 ns = nameNamespace $ elementName el

70 ns = nameNamespace $ elementName el

75 name <- attrThrowXsd "name" el

71 name <- attrThrowXsd "name" el

76 $ "Expected attribute 'name' for element: " <> show (node cursor)

72 $ "Expected attribute 'name' for element: " <> show (node cursor)

73+ let

74+ minOc = maybe 0 (read . T.unpack) (M.lookup "minOccurs" attrs)

75+ maxOc = read . T.unpack <$> M.lookup "maxOccurs" attrs

77 datatypeRef <- case mAttrType of

76 datatypeRef <- case mAttrType of

78 Just dtn -> pure $ DatatypeRef dtn

77 Just dtn -> pure $ DatatypeRef dtn

79 Nothing -> do

78 Nothing -> do

@@ -86,8 +85,10 @@ toElem cursor = do

86 let name = safeHead $ childCursor $| attribute "name"

85 let name = safeHead $ childCursor $| attribute "name"

87 InlineComplex . TypeComplex <$> toComplexType childCursor

86 InlineComplex . TypeComplex <$> toComplexType childCursor

88 pure $ XSD.Element

87 pure $ XSD.Element

89− { name = (ns, name)

88+ { name = (ns, name)

90− , xtype = datatypeRef }

89+ , xtype = datatypeRef

90+ , minOccurs = minOc

91+ , maxOccurs = maxOc }

91 e -> throwXsd $ "[toElem] xsd node not supported: " <> show e

92 e -> throwXsd $ "[toElem] xsd node not supported: " <> show e

92 e ->

93 e ->

93 throwXsd $ "[toElem] element expected, got: " <> show e

94 throwXsd $ "[toElem] element expected, got: " <> show e

@@ -174,5 +175,11 @@ toAttribute cursor = do

174 Nothing -> Optional

175 Nothing -> Optional

175 pure $ Attribute name simpleType useProp

176 pure $ Attribute name simpleType useProp

176

177

177−toXsd :: Document -> Either SomeException (XSD, M.Map Text Datatype)

178+toXsd :: Document -> Either SomeException XSD

178−toXsd doc = runWriterT $ toSchema (fromDocument doc)

179+toXsd doc = do

180+ let cursor = fromDocument doc

181+ XSD <$> (runWriterT $ do

182+ let topLevel = cursor $| laxElement "schema"

183+ if P.null topLevel

184+ then throwXsd "Top-level schema definition not found"

185+ else toElemsAndDatatypes cursor)

xsd-isogen.cabal+4−1

@@ -26,7 +26,8 @@ library

27 default-extensions: OverloadedStrings

28 , LambdaCase

29+ , QuasiQuotes

29− other-extensions: TemplateHaskell

30+ , TemplateHaskell

31 -- Other library packages from which modules are imported.

32 -- Other library packages from which modules are imported.

32 build-depends: base ^>=4.12.0.0

33 build-depends: base ^>=4.12.0.0

@@ -35,8 +36,10 @@ library

35 , lens >= 4.13

36 , lens >= 4.13

36 , mtl

37 , mtl

37 , text

38 , text

39+ , template-haskell

38 , transformers

40 , transformers

39 , xml-conduit

41 , xml-conduit

42+ , xml-isogen

40 , writer-cps-mtl

43 , writer-cps-mtl

41 , uniplate

44 , uniplate