git.iko.soy/gogol
on develop help sign in
Rendering verbosity
4278cc5Brendan Hay
gen/gozen-gen.cabal+7−4
compare with develop
unifiedsplit
@@ -21,10 +21,11 @@ executable gozen-gen
21 main-is: Main.hs
21 main-is: Main.hs
22
22
23 other-modules:
23 other-modules:
24− Gen.IO
25− , Gen.Types
26− , Gen.Formatting
24+ Gen.Formatting
25+ , Gen.IO
27 , Gen.JSON
26 , Gen.JSON
27+ , Gen.Types
28+ , Gen.Types.NS
28
29
29 ghc-options: -Wall -threaded
30 ghc-options: -Wall -threaded
30
31
@@ -43,4 +44,6 @@ executable gozen-gen
43 , formatting
44 , formatting
44 , unordered-containers
45 , unordered-containers
45 , attoparsec
46 , attoparsec
46− , bifunctors
47+ , bifunctors
48+ , semigroups
49+ , text-manipulate
gen/src/Gen/Types.hs+37−11
@@ -13,20 +13,25 @@
13
13
14module Gen.Types where
14module Gen.Types where
15
15
16+--import Control.Lens
16import Data.Aeson
17import Data.Aeson
17import Data.Aeson.TH
18import Data.Aeson.TH
18import qualified Data.Attoparsec.Text as A
19import qualified Data.Attoparsec.Text as A
19import Data.Char
20import Data.Char
20import Data.Function (on)
21import Data.Function (on)
21import qualified Data.HashMap.Strict as Map
22import qualified Data.HashMap.Strict as Map
22−import Data.List (nub, sort)
23+import Data.List (groupBy, nub, sort)
23−import Data.Monoid
24+import Data.List.NonEmpty (NonEmpty (..), nonEmpty)
25+import qualified Data.List.NonEmpty as NE
24import Data.Ord
26import Data.Ord
27+import Data.Semigroup
25import Data.Text (Text)
28import Data.Text (Text)
26import qualified Data.Text as Text
29import qualified Data.Text as Text
27import qualified Data.Text.Lazy as LText
30import qualified Data.Text.Lazy as LText
31+import Data.Text.Manipulate
28import qualified Filesystem.Path.CurrentOS as Path
32import qualified Filesystem.Path.CurrentOS as Path
29import Gen.JSON
33import Gen.JSON
34+import Gen.Types.NS
30import GHC.TypeLits
35import GHC.TypeLits
31import Text.EDE (Template)
36import Text.EDE (Template)
32
37
@@ -58,6 +63,8 @@ data Versions = Versions
58 , _coreVersion :: CoreVer
63 , _coreVersion :: CoreVer
59 } deriving (Show)
64 } deriving (Show)
60
65
66+-- makeClassy ''Versions
67+
61-- FIXME: need a more comprehensive 'vm_alpha' vs 'vm1.1' etc check.
68-- FIXME: need a more comprehensive 'vm_alpha' vs 'vm1.1' etc check.
62data Spec = Spec
69data Spec = Spec
63 { _specName :: Text
70 { _specName :: Text
@@ -96,20 +103,15 @@ instance FromJSON Protocol where
96 e -> fail $ "Unable to parse protocol from " ++ Text.unpack e
103 e -> fail $ "Unable to parse protocol from " ++ Text.unpack e
97
104
98data Service = Service
105data Service = Service
99− { _svcKind :: Text
106+ { _svcTitle :: Text
100− , _svcEtag :: Text
101− , _svcDiscoveryVersion :: Text
102− , _svcId :: Text
103 , _svcName :: Text
107 , _svcName :: Text
104 , _svcCanonicalName :: Maybe Text
108 , _svcCanonicalName :: Maybe Text
105− , _svcTitle :: Text
106− , _svcVersion :: Text
107− , _svcRevision :: Maybe Text
108 , _svcDescription :: Text
109 , _svcDescription :: Text
109− , _svcOwnerDomain :: Text
110+ , _svcRevision :: Maybe Text
111+ , _svcVersion :: Text
110 , _svcOwnerName :: Text
112 , _svcOwnerName :: Text
113+ , _svcOwnerDomain :: Text
111 , _svcPackagePath :: Maybe Text
114 , _svcPackagePath :: Maybe Text
112− , _svcIcons :: Object
113 , _svcDocumentationLink :: Text
115 , _svcDocumentationLink :: Text
114 , _svcProtocol :: Protocol
116 , _svcProtocol :: Protocol
115 , _svcBaseUrl :: Text
117 , _svcBaseUrl :: Text
@@ -122,3 +124,27 @@ data Service = Service
122 } deriving (Show)
124 } deriving (Show)
123
125
124deriveFromJSON (js "_svc") ''Service
126deriveFromJSON (js "_svc") ''Service
127+
128+data Library = Library
129+ { _libName :: Text
130+ , _libTitle :: Text
131+ , _libDescriptions :: [Text]
132+ , _libNamespace :: NS
133+ , _libVersions :: Versions
134+ , _libServices :: NonEmpty Service
135+ }
136+
137+mergeLibraries :: Versions -> [Service] -> [Library]
138+mergeLibraries v = map go . groupBy (on (==) _svcName)
139+ where
140+ go [x] = mk x
141+ go (x:xs) = (mk x) { _libServices = x :| xs }
142+
143+ mk x = Library
144+ { _libName = "gozen-" <> Text.toLower (_svcName x)
145+ , _libTitle = _svcTitle x
146+ , _libDescriptions = []
147+ , _libNamespace = "Network.Google" <> mkNS (toPascal (_svcName x))
148+ , _libVersions = v
149+ , _libServices = x :| []
150+ }
gen/src/Gen/Types/NS.hsnew file+47
@@ -0,0 +1,47 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+-- Module : Gen.Types.NS
4+-- Copyright : (c) 2015 Brendan Hay
5+-- License : Mozilla Public License, v. 2.0.
6+-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
7+-- Stability : provisional
8+-- Portability : non-portable (GHC extensions)
9+
10+module Gen.Types.NS where
11+
12+import Data.Aeson
13+import Data.Monoid
14+import Data.Semigroup
15+import Data.String
16+import Data.Text (Text)
17+import qualified Data.Text as Text
18+import qualified Filesystem.Path.CurrentOS as Path
19+
20+newtype NS = NS [Text]
21+ deriving (Eq, Ord, Show)
22+
23+mkNS :: Text -> NS
24+mkNS = NS . Text.splitOn "."
25+
26+nsToPath :: NS -> Path.FilePath
27+nsToPath (NS xs) = Path.fromText (Text.intercalate "/" xs) Path.<.> "hs"
28+
29+instance IsString NS where
30+ fromString "" = mempty
31+ fromString s = mkNS (fromString s)
32+
33+instance Monoid NS where
34+ mempty = NS []
35+ mappend (NS xs) (NS ys)
36+ | null xs = NS ys
37+ | null ys = NS xs
38+ | otherwise = NS (mappend xs ys)
39+
40+instance Semigroup NS where
41+ (<>) = mappend
42+
43+instance FromJSON NS where
44+ parseJSON = withText "namespace" (pure . mkNS)
45+
46+instance ToJSON NS where
47+ toJSON (NS xs) = toJSON (Text.intercalate "." xs)
gen/src/Main.hs+36−13
@@ -18,6 +18,7 @@ import Control.Lens
18import Control.Monad.State
18import Control.Monad.State
19import Data.List (nub, sort)
19import Data.List (nub, sort)
20import Data.String
20import Data.String
21+import Data.Text (Text)
21import qualified Data.Text as Text
22import qualified Data.Text as Text
22import qualified Filesystem as FS
23import qualified Filesystem as FS
23import Filesystem.Path.CurrentOS
24import Filesystem.Path.CurrentOS
@@ -111,6 +112,7 @@ main = do
111 Opt{..} <- customExecParser (prefs showHelpOnError) options >>= validate
112 Opt{..} <- customExecParser (prefs showHelpOnError) options >>= validate
112
113
113 let ss = nub . sort $ map specFromPath _optModels
114 let ss = nub . sort $ map specFromPath _optModels
115+ i = length ss
114
116
115 run $ do
117 run $ do
116 title "Initialising..." <* done
118 title "Initialising..." <* done
@@ -127,20 +129,28 @@ main = do
127 <* lift done
129 <* lift done
128
130
129 say ("Found " % int % " model specifications.") (length _optModels)
131 say ("Found " % int % " model specifications.") (length _optModels)
130− say ("Selected " % int % " newest models.") (length ss)
132+ say ("Selected " % int % " newest models.") i
131−
132− forM_ (zip [1..] ss) $ \(j, Spec{..}) -> do
133− title ("[" % int % "/" % int % "] model:" % stext)
134− (j :: Int) (length ss) _specName
135
133
134+ svcs <- counter "model" ss $ \Spec{..} -> do
136 say ("Using version " % stext) _specVersion
135 say ("Using version " % stext) _specVersion
137
136
138− -- cfg <- JS.required (_optConfigs </> (m ^. configFile))
137+ s <- readBSFile _specPath >>= JS.decode
139− -- >>= hoistEither . JS.parse
138+
139+ say ("Successfully parsed '" % stext % "' API definition.")
140+ (_svcTitle s)
141+
142+ done
143+
144+ return s
140
145
141− svc <- readBSFile _specPath >>= JS.decode
146+ let libs = mergeLibraries _optVersions svcs
142
147
148+ _ <- counter "library" libs $ \l -> do
149+ say ("Creating " % stext % " package.") (_libTitle l)
150+
151+ done
152+
143− say ("Service: " % string) (show (svc :: Service))
153+-- say ("Service: " % string) (
144
154
145 -- api <- sequence
155 -- api <- sequence
146 -- [ JS.optional (_optAnnexes </> (m ^. annexFile))
156 -- [ JS.optional (_optAnnexes </> (m ^. annexFile))
@@ -150,9 +160,6 @@ main = do
150 -- , pure r
160 -- , pure r
151 -- ] >>= hoistEither . JS.parse . JS.merge
161 -- ] >>= hoistEither . JS.parse . JS.merge
152
162
153− -- say ("Successfully parsed '" % stext % "' API definition")
154− -- (api ^. serviceFullName)
155−
156 -- lib <- hoistEither (AST.rewrite _optVersions cfg api)
163 -- lib <- hoistEither (AST.rewrite _optVersions cfg api)
157
164
158 -- dir <- hoistEither (Tree.populate _optOutput tmpl lib)
165 -- dir <- hoistEither (Tree.populate _optOutput tmpl lib)
@@ -166,4 +173,20 @@ main = do
166
173
167 -- done
174 -- done
168
175
169− -- title ("Successfully processed " % int % " models.") i
176+ title ("Successfully processed " % int % " models.") i
177+ title ("Successfully created " % int % " library packages.") (length libs)
178+
179+class HasName a where getName :: a -> Text
180+instance HasName Spec where getName = _specName
181+instance HasName Library where getName = _libName
182+
183+-- counter :: (MonadIO n, m ~ ExceptT n Error, HasName a)
184+-- => [a]
185+-- -> (a -> m b)
186+-- -> m [b]
187+counter k xs f = forM (zip [1..] xs) $ \(n, x) -> do
188+ title ("[" % int % "/" % int % "] " % stext % ":" % stext)
189+ (n :: Int) i k (getName x)
190+ f x
191+ where
192+ i = length xs