b6a29af · gogol · git.iko.soy

git.iko.soy/gogol

Parsing service outline

commitb6a29af63fb01eec8bd3beb4282a22e242f3305a authorBrendan Hay <brendan.g.hay@gmail.com> dateTue 22 Sep 2015, 13:48 (11 years ago) parent58c807c

4 files changed+122−9

compare with develop

unifiedsplit

gen/gozen-gen.cabal+4−1 gen/src/Gen/JSON.hs+63 gen/src/Gen/Types.hs+47−3 gen/src/Main.hs+8−5

gen/gozen-gen.cabal+4−1

@@ -23,6 +23,8 @@ executable gozen-gen

2323 other-modules:

2424 Gen.IO

2525 , Gen.Types

26+ , Gen.Formatting

27+ , Gen.JSON

2628

2729 ghc-options: -Wall -threaded

2830

@@ -40,4 +42,5 @@ executable gozen-gen

4042 , errors

4143 , formatting

4244 , unordered-containers

43− , attoparsec

45+ , attoparsec

46+ , bifunctors

gen/src/Gen/JSON.hsnew file+63

@@ -0,0 +1,63 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE OverloadedStrings #-}

4+-- Module : Gen.JSON

6+-- License : Mozilla Public License, v. 2.0.

7+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>

8+-- Stability : provisional

9+-- Portability : non-portable (GHC extensions)

10+

11+module Gen.JSON where

12+

13+import Control.Error

14+import Control.Monad.Except

15+import Data.Aeson hiding (decode)

16+import Data.Aeson.Types

17+import Data.Bifunctor

18+import Data.ByteString (ByteString)

19+import qualified Data.ByteString.Lazy as LBS

20+import Data.Char

21+import qualified Data.HashMap.Strict as Map

22+import Data.List

23+import qualified Data.Text.Lazy as LText

24+import qualified Text.EDE as EDE

25+

26+decode :: (Monad m, FromJSON a) => ByteString -> ExceptT LText.Text m a

27+decode = hoistEither . first LText.pack . eitherDecode' . LBS.fromStrict

28+

29+js :: String -> Options

30+js pre = defaultOptions

31+ { constructorTagModifier = map toLower

32+ , fieldLabelModifier = \s ->

33+ let x:xs = drop (length pre) s

34+ in toLower x : xs

35+ }

36+

37+-- optional :: MonadIO m => Path -> ExceptT Error m Object

38+-- optional f = readBSFile f `catchError` const (return "{}")

39+-- >>= hoistEither . decode

40+

41+-- objectErr :: ToJSON a => String -> a -> Either Error Object

42+-- objectErr n =

43+-- note (format ("Failed to extract JSON object from value " % string) n)

44+-- . EDE.fromValue

45+-- . toJSON

46+

47+-- decode :: FromJByteString -> Either Error a

48+-- decode = first LText.pack . eitherDecode' . LBS.fromStrict

49+

50+-- parse :: FromJSON a => Object -> Either Error a

51+-- parse = first LText.pack . parseEither parseJSON . Object

52+

53+-- merge :: [Object] -> Object

54+-- merge = foldl' go mempty

55+-- where

56+-- go :: Object -> Object -> Object

57+-- go = Map.unionWith value

58+

59+-- value :: Value -> Value -> Value

60+-- value l r =

61+-- case (l, r) of

62+-- (Object x, Object y) -> Object (x `go` y)

63+-- (_, _) -> l

gen/src/Gen/Types.hs+47−3

@@ -1,6 +1,8 @@

11{-# LANGUAGE DataKinds #-}

22{-# LANGUAGE KindSignatures #-}

3+{-# LANGUAGE LambdaCase #-}

34{-# LANGUAGE OverloadedStrings #-}

5+{-# LANGUAGE TemplateHaskell #-}

57-- Module : Gen.Types

@@ -11,7 +13,10 @@

1113

1214module Gen.Types where

1315

16+import Data.Aeson

17+import Data.Aeson.TH

1418import qualified Data.Attoparsec.Text as A

19+import Data.Char

1520import Data.Function (on)

1621import qualified Data.HashMap.Strict as Map

1722import Data.List (nub, sort)

@@ -21,6 +26,7 @@ import Data.Text (Text)

2126import qualified Data.Text as Text

2227import qualified Data.Text.Lazy as LText

2328import qualified Filesystem.Path.CurrentOS as Path

29+import Gen.JSON

2430import GHC.TypeLits

2531import Text.EDE (Template)

2632

@@ -69,12 +75,50 @@ instance Ord Spec where

6975 <> on compare (Down . _specVersion) a b

7076

7177specFromPath :: Path -> Spec

72−specFromPath x = Spec (n <> v) p v x

78+specFromPath x = Spec n p v x

7379 where

74− n = Text.intercalate "/"

75− . drop 1

80+ -- FIXME:

81+ n = Text.init

82+ . Text.intercalate "/"

83+ . drop 2

7684 . dropWhile (/= "model")

7785 $ Text.split (== '/') p

7886

7987 p = toTextIgnore (Path.parent (Path.parent x))

8088 v = toTextIgnore (Path.dirname x)

89+

90+data Protocol = REST

91+ deriving (Eq, Show)

92+

93+instance FromJSON Protocol where

94+ parseJSON = withText "protocol" $ \case

95+ "rest" -> pure REST

96+ e -> fail $ "Unable to parse protocol from " ++ Text.unpack e

97+

98+data Service = Service

99+ { _svcKind :: Text

100+ , _svcEtag :: Text

101+ , _svcDiscoveryVersion :: Text

102+ , _svcId :: Text

103+ , _svcName :: Text

104+ , _svcCanonicalName :: Maybe Text

105+ , _svcTitle :: Text

106+ , _svcVersion :: Text

107+ , _svcRevision :: Maybe Text

108+ , _svcDescription :: Text

109+ , _svcOwnerDomain :: Text

110+ , _svcOwnerName :: Text

111+ , _svcPackagePath :: Maybe Text

112+ , _svcIcons :: Object

113+ , _svcDocumentationLink :: Text

114+ , _svcProtocol :: Protocol

115+ , _svcBaseUrl :: Text

116+ , _svcRootUrl :: Text

117+ , _svcServicePath :: Text

118+ , _svcBatchPath :: Text

119+ , _svcParameters :: Object

120+ , _svcAuth :: Maybe Object

121+ , _svcSchemas :: Object

122+ } deriving (Show)

123+

124+deriveFromJSON (js "_svc") ''Service

gen/src/Main.hs+8−5

@@ -23,6 +23,7 @@ import qualified Filesystem as FS

2323import Filesystem.Path.CurrentOS

2424import Gen.Formatting

2525import Gen.IO

26+import qualified Gen.JSON as JS

2627import Gen.Types

2728import Options.Applicative

2829

@@ -128,17 +129,19 @@ main = do

128129 say ("Found " % int % " model specifications.") (length _optModels)

129130 say ("Selected " % int % " newest models.") (length ss)

130131

131− forM_ (zip [1..] ss) $ \(j, s) -> do

132+ forM_ (zip [1..] ss) $ \(j, Spec{..}) -> do

132133 title ("[" % int % "/" % int % "] model:" % stext)

133− (j :: Int) (length ss) (_specName s)

134+ (j :: Int) (length ss) _specName

134135

135− -- m <- listDir f >>= hoistEither . loadModel f

136−

137− -- say ("Using version " % dateDash) (m ^. modelVersion)

136+ say ("Using version " % stext) _specVersion

138137

139138 -- cfg <- JS.required (_optConfigs </> (m ^. configFile))

140139 -- >>= hoistEither . JS.parse

141140

141+ svc <- readBSFile _specPath >>= JS.decode

142+

143+ say ("Service: " % string) (show (svc :: Service))

144+

142145 -- api <- sequence

143146 -- [ JS.optional (_optAnnexes </> (m ^. annexFile))

144147 -- , JS.required (m ^. serviceFile)