1bfb0b1 · gogol · git.iko.soy

git.iko.soy/gogol

Disambiguating field prefixes

commit1bfb0b1e53abbd59a4f67eb76365741686b65949 authorBrendan Hay <brendan.g.hay@gmail.com> dateFri 25 Sep 2015, 11:51 (11 years ago) parentd35038a

4 files changed+118−61

compare with develop

unifiedsplit

gen/gozen-gen.cabal+4−2 gen/src/Gen/Solve.hs+75−8 gen/src/Gen/Text.hs+35−49 gen/stack.yaml+4−2

gen/gozen-gen.cabal+4−2

@@ -42,11 +42,11 @@ executable gozen-gen

4242 aeson

4343 , attoparsec

4444 , base == 4.8.*

45+ , bifunctors

4546 , bytestring

4647 , case-insensitive

4748 , directory-tree

4849 , ede

49− , bifunctors

5050 , errors

5151 , formatting

5252 , hashable

@@ -61,5 +61,7 @@ executable gozen-gen

6161 , system-fileio

6262 , system-filepath

6363 , text

64+ , text-icu

6465 , text-manipulate

65− , unordered-containers

66+ , text-regex-replace

67+ , unordered-containers

gen/src/Gen/Solve.hs+75−8

@@ -9,6 +9,7 @@

99{-# LANGUAGE RankNTypes #-}

1010{-# LANGUAGE RecordWildCards #-}

1111{-# LANGUAGE TemplateHaskell #-}

12+{-# LANGUAGE ViewPatterns #-}

1213

1314-- Module : Gen.Solve

@@ -27,6 +28,8 @@ import Control.Monad.State.Strict

2728import Data.CaseInsensitive (CI)

2829import qualified Data.CaseInsensitive as CI

2930import Data.Char (toLower)

31+import Data.Hashable

32+import qualified Data.HashMap.Strict as Map

3033import qualified Data.HashMap.Strict as Map

3134import qualified Data.HashSet as Set

3235import Data.List (intersect)

@@ -36,6 +39,7 @@ import Data.Text (Text)

3639import qualified Data.Text as Text

3740import Data.Text.Manipulate

3841import Gen.Formatting

42+import Gen.Text

3943import Gen.Types

4044import Prelude hiding (sum)

4145

@@ -154,17 +158,80 @@ derive k = loc "derive" k $ memo derived k go

154158 base = [DEq, DRead, DShow, DData, DTypeable, DGeneric]

155159

156160prefix :: Id -> AST Pre

157−prefix k = loc "prefix" k $ memo prefixed k go

161+prefix k = loc "prefix" k $ memo prefixed k typ

162+ where

163+ typ = \case

164+ Obj i rs -> field rs >> pure (Pre k)

165+ Enum i vs ds -> pure (Pre k)

166+ _ -> pure (Pre k)

167+

168+ field (keys -> ks) = do

169+ p <- uniq fields (acronymPrefixes k) ks

170+ forM_ ks $ \n ->

171+ prefixed %= Map.insert (k <> key n) (Pre (key p <> key n))

172+ pure (Pre (key p))

173+

174+ key = idFromText . CI.foldedCase

175+

176+ uniq :: Lens' Memo Seen

177+ -> [CI Text]

178+ -> Set (CI Text)

179+ -> AST (CI Text)

180+ uniq _ [] ks = failure ("Unable to generate unique prefix: " % fid) k

181+ uniq seen (x:xs) ks = do

182+ m <- uses seen (Map.lookup x)

183+ case m of

184+ Just ys | overlap ys ks

185+ -> uniq seen xs ks

186+ _ -> do

187+ seen %= Map.insertWith (<>) x ks

188+ return x

189+

190+overlap :: (Eq a, Hashable a) => Set a -> Set a -> Bool

191+overlap xs ys = not . Set.null $ Set.intersection xs ys

192+

193+keys :: Map Id a -> Set (CI Text)

194+keys = Set.fromList . map (CI.mk . idToText) . Map.keys

195+

196+acronymPrefixes :: Id -> [CI Text]

197+acronymPrefixes (idToText -> n) = map CI.mk (xs ++ map suffix ys)

158198 where

159− go (Obj i rs) = Map.traverseWithKey prop rs >> pure (Pre k)

160− go s = pure (Pre k)

199+ -- Take the next char

200+ suffix x = Text.snoc x c

201+ where

202+ c | Text.length x >= 2 = Text.head (Text.drop 1 x)

203+ | otherwise = Text.head x

204+

205+ xs = catMaybes [r1, r2, r3, r4, r5, r6]

206+ ys = catMaybes [r1, r2, r3, r4, r6]

207+

208+ a = camelAcronym n

209+ a' = upperAcronym n

210+

211+ limit = 3

212+

213+ -- Full name if leq limit

214+ r1 | Text.length n <= limit = Just n

215+ | otherwise = Nothing

216+

217+ -- VpcPeeringInfo -> VPI

218+ r2 = toAcronym a

219+

220+ -- VpcPeeringInfo -> VPCPI

221+ r3 | x /= r2 = x

222+ | otherwise = Nothing

223+ where

224+ x = toAcronym a'

225+

226+ -- SomeTestTType -> S

227+ r4 = Text.toUpper <$> safeHead n

161228

162− prop n _ = do

163− let p = Pre (idFromText (acronym $ idToText k) <> n)

164− prefixed %= Map.insert (k <> n) p

165− pure p

229+ -- SomeTypes -> STS (retain pural)

230+ r5 | Text.isSuffixOf "s" n = flip Text.snoc 's' <$> (r2 <|> r3)

231+ | otherwise = Nothing

166232

167− acronym = foldMap (Text.singleton . toLower . Text.head) . splitWords

233+ -- SomeTestTType -> Som

234+ r6 = Text.take limit <$> listToMaybe (splitWords a)

168235

169236loc :: String -> Id -> a -> a

170237loc _ _ = id -- trace (n ++ ": " ++ Text.unpack (refToText r))

gen/src/Gen/Text.hs+35−49

@@ -17,32 +17,21 @@ import Control.Error

1717import Control.Monad

1818import Data.Bifunctor

1919import Data.Char

20−import qualified Data.Foldable as Fold

21−import qualified Data.HashSet as Set

20+import qualified Data.Foldable as Fold

21+import qualified Data.HashSet as Set

2222import Data.Monoid

2323import Data.String

24−import Data.Text (Text)

25−import qualified Data.Text as Text

26−-- import Data.Text.ICU (Regex)

27−-- import Data.Text.ICU.Replace (Replace)

28−-- import qualified Data.Text.ICU.Replace as RE

24+import Data.Text (Text)

25+import qualified Data.Text as Text

26+import Data.Text.ICU (Regex)

27+import Data.Text.ICU.Replace (Replace)

28+import qualified Data.Text.ICU.Replace as RE

2929import Data.Text.Manipulate

30−import Text.Parsec.Language (haskellDef)

31−import Text.Parsec.Token (reservedNames)

30+import Text.Parsec.Language (haskellDef)

31+import Text.Parsec.Token (reservedNames)

3232

33−-- asText :: (Text -> Text) -> String -> String

34−-- asText f = Text.unpack . f . Text.pack

35−

36−-- dropLower :: Text -> Text

37−-- dropLower = Text.dropWhile (not . isUpper)

38−

39−-- safeHead :: Text -> Maybe Text

40−-- safeHead = fmap (Text.singleton . fst) . Text.uncons

41−

42−-- stripLens :: Text -> Text

43−-- stripLens t

44−-- | "_" `Text.isPrefixOf` t = lowerHead (dropLower t)

45−-- | otherwise = t

33+safeHead :: Text -> Maybe Text

34+safeHead = fmap (Text.singleton . fst) . Text.uncons

4635

4736stripPrefix :: Text -> Text -> Text

4837stripPrefix p t = Text.strip . fromMaybe t $ p `Text.stripPrefix` t

@@ -85,30 +74,27 @@ renameReserved x

8574 , "error"

8675 ] ++ map Text.pack (reservedNames haskellDef)

8776

88−-- camelAcronym :: Text -> Text

89−-- camelAcronym x = replaceAll x xs

90−-- where

91−-- xs = map (bimap fromString fromString) acronyms

92−

93−-- lowerFirstAcronym :: Text -> Text

94−-- lowerFirstAcronym x = replaceAll x xs

95−-- where

96−-- xs = map (bimap (fromString . ('^':)) (fromString . f)) acronyms

97−

98−-- f (c:cs) = toLower c : cs

99−-- f [] = []

100−

101−-- replaceAll :: Text -> [(Regex, Replace)] -> Text

102−-- replaceAll = Fold.foldl' (flip (uncurry RE.replaceAll))

103−

104−-- upperAcronym :: Text -> Text

105−-- upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs

106−-- where

107−-- xs :: [(Regex, Replace)]

108−-- xs = [ ("Acl", "ACL")

109−-- ]

110−

111−-- acronyms :: [(String, String)]

112−-- acronyms =

113−-- [ ("ACL", "Acl")

114−-- ]

77+camelAcronym :: Text -> Text

78+camelAcronym x = replaceAll x xs

79+ where

80+ xs = map (bimap fromString fromString) acronyms

81+

82+lowerFirstAcronym :: Text -> Text

83+lowerFirstAcronym x = replaceAll x xs

84+ where

85+ xs = map (bimap (fromString . ('^':)) (fromString . f)) acronyms

86+

87+ f (c:cs) = toLower c : cs

88+ f [] = []

89+

90+replaceAll :: Text -> [(Regex, Replace)] -> Text

91+replaceAll = Fold.foldl' (flip (uncurry RE.replaceAll))

92+

93+upperAcronym :: Text -> Text

94+upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs

95+ where

96+ xs :: [(Regex, Replace)]

97+ xs = []

98+

99+acronyms :: [(String, String)]

100+acronyms = []

gen/stack.yaml+4−2

@@ -1,4 +1,6 @@

11resolver: nightly-2015-08-06

22flags: {}

3−packages: ['.']

4−extra-deps: []

3+extra-deps:

4+ - text-regex-replace-0.1.1.1

5+packages:

6+ - '.'