1ee6235 · typeable/xsd-isogen

git.iko.soy/typeable/xsd-isogen

Moved everything to arguments and added header option

commit1ee62356b5fd189605413b90979148f7b552345b authoriko <ilyakooo0@gmail.com> dateMon 27 Jan 2020, 20:26 (7 years ago) parentb49e010

5 files changed+172−26

compare with master

unifiedsplit

README.md+3−3 src/Main.hs+14−19 src/Options.hs+80 stack.yaml+67 xsd-isogen.cabal+8−4

README.md+3−3

@@ -5,10 +5,10 @@ Tool to generate xml-isogen descriptions from xsd files

55Usage

66=====

8−Use `xsd-isogen in.xsd Generator > out.hs` for queries.

8+Use `xsd-isogen -i in.xsd -m Generator > out.hs` for queries.

10−Use `xsd-isogen in.xsd Parser > out.hs` for responses.

10+Use `xsd-isogen -i in.xsd -m Parser > out.hs` for responses.

1111

12−Use `xsd-isogen in.xsd Both > out.hs` for common definitions.

12+Use `xsd-isogen -i in.xsd -m Both > out.hs` for common definitions.

1313

1414If there are conflicting field names in some datatypes, one of the the datatype names gets consecutive numbers starting from 2 appended to it (so that the field name prefix changes) until there are no more conflicts.

src/Main.hs+14−19

@@ -25,19 +25,13 @@ import Debug.Trace

2525import System.Environment

2626import System.IO

2727import Text.XSD

28+import Options

29+import Data.Maybe

2830

2931

3032makeNamePrefix :: Text -> Text

3133makeNamePrefix = T.map C.toLower . T.filter (\c -> C.isUpper c || C.isDigit c)

3234

33−data GenType = Parser | Generator | Both

34− deriving (Read, Show)

35−

36−genTypeToText :: GenType -> Text

37−genTypeToText Parser = "Parser"

38−genTypeToText Generator = "Generator"

39−genTypeToText Both = "Both"

40−

4135type GenMonad = ReaderT DatatypeMap (Writer Text)

4236

4337class Fields a where

@@ -245,13 +239,13 @@ tellGen code comment =

245239runGen :: DatatypeMap -> GenMonad a -> Text

246240runGen dm act = execWriter $ runReaderT act dm

247241

248−generateIsoXml :: GenType -> XSD -> Text

249−generateIsoXml genType (XSD (e,dm)) =

242+generateIsoXml :: Maybe Header -> ModuleName -> GenType -> XSD -> Text

243+generateIsoXml mHeader name genType xsd@(XSD (e,dm)) =

250244 let

251245 (dList, el) = untwistDeps e dm

252− in (header genType <>) . runGen dm $ do

253− for_ dList $ \(t,dt) ->

254− generateIsoDatatype genType t dt []

246+ in (header mHeader name genType <>) . runGen dm $ do

247+ for_ dList $ \(t,dt) -> do

248+ generateIsoDatatype genType (Just t) dt []

255249 for_ el (generateIsoRecord genType)

256250

257251toQualifier :: Int -> Int -> Text

@@ -262,9 +256,10 @@ toQualifier minOc maxOc

262256 | minOc == 1 && maxOc < minOc = error "maxOccurs < minOccurs"

263257 | otherwise = "*"

264258

265−header :: GenType -> Text

266−header genType = T.unlines $

267− [ "module Dummy where"

259+header :: Maybe Header -> ModuleName -> GenType -> Text

260+header mHeader name genType = T.unlines $

261+ maybeToList (T.unlines . fmap ("-- " <>) . T.lines <$> mHeader) <>

262+ [ "module " <> name <> " where"

268263 , ""

269264 , "import Control.DeepSeq"

270265 , "import Data.THGen.XML"

@@ -450,10 +445,10 @@ generateIsoField

450445

451446main :: IO ()

452447main = do

453− (inFile:mode:_) <- getArgs

454− xml <- BL.readFile inFile

448+ Options{..} <- getOptions

449+ xml <- BL.readFile oInput

455450 let

456451 xsd = case parseXSD def xml of

457452 Right xsd' -> xsd'

458453 Left e -> error $ show e

459− T.hPutStrLn stdout $ generateIsoXml (read mode) xsd

454+ T.hPutStrLn stdout $ generateIsoXml oHeader oModule oMode xsd

src/Options.hsnew file+80

@@ -0,0 +1,80 @@

1+module Options

2+ ( Options(..)

3+ , optionsParser

4+ , getOptions

5+ , GenType(..)

6+ , genTypeToText

7+ , ModuleName

8+ , Header

9+ ) where

10+

11+import Data.Text (Text)

12+import qualified Data.Text as T

13+import Data.Version (showVersion)

14+import Options.Applicative

15+import Paths_xsd_isogen (version)

16+import Data.List

17+

18+

19+data GenType = Parser | Generator | Both

20+ deriving (Read, Show, Bounded, Enum)

21+

22+genTypeToText :: GenType -> Text

23+genTypeToText Parser = "Parser"

24+genTypeToText Generator = "Generator"

25+genTypeToText Both = "Both"

26+

27+type ModuleName = Text

28+type Header = Text

29+

30+data Options = Options

31+ { oHeader :: Maybe Header

32+ , oMode :: GenType

33+ , oInput :: FilePath

34+ , oModule :: ModuleName

35+ }

36+

37+optionsParser :: Parser Options

38+optionsParser = Options

39+ <$> ( flag' Nothing

40+ ( long "no-header"

41+ <> help "Do not place a header at the top of the file."

42+ ) <|> Just <$> strOption

43+ ( long "header"

44+ <> help "A custom header to be placed at the top of the file."

45+ <> value ("This file was generated by xsd-isogen version "

46+ <> T.pack (showVersion version)

47+ <> "\nhttps://github.com/dredozubov/xsd-isogen")

48+ )

49+ )

50+ <*> option auto

51+ ( long "mode"

52+ <> short 'm'

53+ <> value Both

54+ <> help ("Whether to generate both parsers and generators. One of: "

55+ <> (mconcat . intersperse ", " . fmap show

56+ $ [minBound @GenType .. maxBound]) <> ".")

57+ )

58+ <*> strOption

59+ ( long "input"

60+ <> short 'i'

61+ <> help "Path to the input .xsd file."

62+ )

63+ <*> strOption

64+ ( long "name"

65+ <> short 'n'

66+ <> help "Specify the name of the generated module."

67+ <> value "Dummy"

68+ )

69+

70+

71+getOptions :: IO Options

72+getOptions = execParser $ info (optionsParser <**> helper)

73+ $ fullDesc

74+ <> header

75+ ( "xsd-isogen version " <> showVersion version

76+ <> " (https://github.com/dredozubov/xsd-isogen)"

77+ )

78+ <> progDesc ( "A tool for generating xml-isogen-compatible "

79+ <> "(https://github.com/typeable/xml-isogen) .hs files from .xsd files."

80+ )

stack.yamlnew file+67

@@ -0,0 +1,67 @@

1+# This file was automatically generated by 'stack init'

2+#

3+# Some commonly used options have been documented as comments in this file.

4+# For advanced use and comprehensive documentation of the format, please see:

5+# https://docs.haskellstack.org/en/stable/yaml_configuration/

7+# Resolver to choose a 'specific' stackage snapshot or a compiler version.

8+# A snapshot resolver dictates the compiler version and the set of packages

9+# to be used for project dependencies. For example:

10+#

11+# resolver: lts-3.5

12+# resolver: nightly-2015-09-21

13+# resolver: ghc-7.10.2

14+#

15+# The location of a snapshot can be provided as a file or url. Stack assumes

16+# a snapshot provided as a file might change, whereas a url resource does not.

17+#

18+# resolver: ./custom-snapshot.yaml

19+# resolver: https://example.com/snapshots/2018-01-01.yaml

20+resolver: lts-14.21

21+

22+# User packages to be built.

23+# Various formats can be used as shown in the example below.

24+#

25+# packages:

26+# - some-directory

27+# - https://example.com/foo/bar/baz-0.0.2.tar.gz

28+# subdirs:

29+# - auto-update

30+# - wai

31+packages:

32+- .

33+- dist-newstyle/src/xsd-parser-4708f64ddc20d345

34+# Dependency packages to be pulled from upstream that are not in the resolver.

35+# These entries can reference officially published versions as well as

36+# forks / in-progress versions pinned to a git hash. For example:

37+#

38+# extra-deps:

39+# - acme-missiles-0.3

40+# - git: https://github.com/commercialhaskell/stack.git

41+# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a

42+#

43+# extra-deps: []

44+

45+# Override default flag values for local packages and extra-deps

46+# flags: {}

47+

48+# Extra package databases containing global packages

49+# extra-package-dbs: []

50+

51+# Control whether we use the GHC we find on the path

52+# system-ghc: true

53+#

54+# Require a specific version of stack, using version ranges

55+# require-stack-version: -any # Default

56+# require-stack-version: ">=2.1"

57+#

58+# Override the architecture used by stack, especially useful on Windows

59+# arch: i386

60+# arch: x86_64

61+#

62+# Extra directories used by stack for building

63+# extra-include-dirs: [/path/to/dir]

64+# extra-lib-dirs: [/path/to/dir]

65+#

66+# Allow a newer minor version of GHC than the snapshot specifies

67+# compiler-check: newer-minor

xsd-isogen.cabal+8−4

@@ -10,26 +10,27 @@ synopsis: Generate xml-isogen DSL from xsd files

1010homepage: github.com/dredozubov/xsd-isogen

1111-- bug-reports:

1212license: BSD-3-Clause

13−license-file: LICENSE

13+-- license-file: LICENSE

1414author: Denis Redozubov

1515maintainer: denis.redozubov@gmail.com

1616-- copyright:

1717category: Text

18−extra-source-files: CHANGELOG.md

18+-- extra-source-files: CHANGELOG.md

1919

2020executable xsd-isogen

2121 main-is: Main.hs

22− -- other-modules:

22+ other-modules: Options

2323 -- other-extensions:

2424 build-depends: base ^>=4.12.0.0

2525 , bytestring

2626 , containers

2727 , data-default

2828 , mtl

29+ , optparse-applicative

2930 , text

31+ , unordered-containers

3032 , writer-cps-mtl

3133 , xsd-parser

32− , unordered-containers

3334 hs-source-dirs: src

3435 default-language: Haskell2010

3536 ghc-options: -fwarn-unused-binds

@@ -43,3 +44,6 @@ executable xsd-isogen

4344 , -Widentities

4445 , -Wredundant-constraints

4546 , -Wmissing-export-lists

47+ default-extensions: TypeApplications

48+ , OverloadedStrings

49+ , RecordWildCards