git.iko.soy/gogol
on develop help sign in
Disambiguating field prefixes
1bfb0b1Brendan Hay
gen/gozen-gen.cabal+4−2
compare with develop
unifiedsplit
@@ -42,11 +42,11 @@ executable gozen-gen
42 aeson
42 aeson
43 , attoparsec
43 , attoparsec
44 , base == 4.8.*
44 , base == 4.8.*
45+ , bifunctors
45 , bytestring
46 , bytestring
46 , case-insensitive
47 , case-insensitive
47 , directory-tree
48 , directory-tree
48 , ede
49 , ede
49− , bifunctors
50 , errors
50 , errors
51 , formatting
51 , formatting
52 , hashable
52 , hashable
@@ -61,5 +61,7 @@ executable gozen-gen
61 , system-fileio
61 , system-fileio
62 , system-filepath
62 , system-filepath
63 , text
63 , text
64+ , text-icu
64 , text-manipulate
65 , text-manipulate
66+ , text-regex-replace
65− , unordered-containers
67+ , unordered-containers
gen/src/Gen/Solve.hs+75−8
@@ -9,6 +9,7 @@
9{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RecordWildCards #-}
10{-# LANGUAGE RecordWildCards #-}
11{-# LANGUAGE TemplateHaskell #-}
11{-# LANGUAGE TemplateHaskell #-}
12+{-# LANGUAGE ViewPatterns #-}
12
13
13-- Module : Gen.Solve
14-- Module : Gen.Solve
14-- Copyright : (c) 2015 Brendan Hay
15-- Copyright : (c) 2015 Brendan Hay
@@ -27,6 +28,8 @@ import Control.Monad.State.Strict
27import Data.CaseInsensitive (CI)
28import Data.CaseInsensitive (CI)
28import qualified Data.CaseInsensitive as CI
29import qualified Data.CaseInsensitive as CI
29import Data.Char (toLower)
30import Data.Char (toLower)
31+import Data.Hashable
32+import qualified Data.HashMap.Strict as Map
30import qualified Data.HashMap.Strict as Map
33import qualified Data.HashMap.Strict as Map
31import qualified Data.HashSet as Set
34import qualified Data.HashSet as Set
32import Data.List (intersect)
35import Data.List (intersect)
@@ -36,6 +39,7 @@ import Data.Text (Text)
36import qualified Data.Text as Text
39import qualified Data.Text as Text
37import Data.Text.Manipulate
40import Data.Text.Manipulate
38import Gen.Formatting
41import Gen.Formatting
42+import Gen.Text
39import Gen.Types
43import Gen.Types
40import Prelude hiding (sum)
44import Prelude hiding (sum)
41
45
@@ -154,17 +158,80 @@ derive k = loc "derive" k $ memo derived k go
154 base = [DEq, DRead, DShow, DData, DTypeable, DGeneric]
158 base = [DEq, DRead, DShow, DData, DTypeable, DGeneric]
155
159
156prefix :: Id -> AST Pre
160prefix :: 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)
158 where
198 where
159− go (Obj i rs) = Map.traverseWithKey prop rs >> pure (Pre k)
199+ -- Take the next char
160− go s = pure (Pre k)
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
161
228
162− prop n _ = do
229+ -- SomeTypes -> STS (retain pural)
163− let p = Pre (idFromText (acronym $ idToText k) <> n)
230+ r5 | Text.isSuffixOf "s" n = flip Text.snoc 's' <$> (r2 <|> r3)
164− prefixed %= Map.insert (k <> n) p
231+ | otherwise = Nothing
165− pure p
166
232
167− acronym = foldMap (Text.singleton . toLower . Text.head) . splitWords
233+ -- SomeTestTType -> Som
234+ r6 = Text.take limit <$> listToMaybe (splitWords a)
168
235
169loc :: String -> Id -> a -> a
236loc :: String -> Id -> a -> a
170loc _ _ = id -- trace (n ++ ": " ++ Text.unpack (refToText r))
237loc _ _ = id -- trace (n ++ ": " ++ Text.unpack (refToText r))
gen/src/Gen/Text.hs+35−49
@@ -17,32 +17,21 @@ import Control.Error
17import Control.Monad
17import Control.Monad
18import Data.Bifunctor
18import Data.Bifunctor
19import Data.Char
19import Data.Char
20−import qualified Data.Foldable as Fold
20+import qualified Data.Foldable as Fold
21−import qualified Data.HashSet as Set
21+import qualified Data.HashSet as Set
22import Data.Monoid
22import Data.Monoid
23import Data.String
23import Data.String
24−import Data.Text (Text)
24+import Data.Text (Text)
25−import qualified Data.Text as Text
25+import qualified Data.Text as Text
26−-- import Data.Text.ICU (Regex)
26+import Data.Text.ICU (Regex)
27−-- import Data.Text.ICU.Replace (Replace)
27+import Data.Text.ICU.Replace (Replace)
28−-- import qualified Data.Text.ICU.Replace as RE
28+import qualified Data.Text.ICU.Replace as RE
29import Data.Text.Manipulate
29import Data.Text.Manipulate
30−import Text.Parsec.Language (haskellDef)
30+import Text.Parsec.Language (haskellDef)
31−import Text.Parsec.Token (reservedNames)
31+import Text.Parsec.Token (reservedNames)
32
32
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
33+safeHead :: Text -> Maybe Text
40−-- safeHead = fmap (Text.singleton . fst) . Text.uncons
34+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
46
35
47stripPrefix :: Text -> Text -> Text
36stripPrefix :: Text -> Text -> Text
48stripPrefix p t = Text.strip . fromMaybe t $ p `Text.stripPrefix` t
37stripPrefix p t = Text.strip . fromMaybe t $ p `Text.stripPrefix` t
@@ -85,30 +74,27 @@ renameReserved x
85 , "error"
74 , "error"
86 ] ++ map Text.pack (reservedNames haskellDef)
75 ] ++ map Text.pack (reservedNames haskellDef)
87
76
88−-- camelAcronym :: Text -> Text
77+camelAcronym :: Text -> Text
89−-- camelAcronym x = replaceAll x xs
78+camelAcronym x = replaceAll x xs
90−-- where
79+ where
91−-- xs = map (bimap fromString fromString) acronyms
80+ xs = map (bimap fromString fromString) acronyms
92−
81+
93−-- lowerFirstAcronym :: Text -> Text
82+lowerFirstAcronym :: Text -> Text
94−-- lowerFirstAcronym x = replaceAll x xs
83+lowerFirstAcronym x = replaceAll x xs
95−-- where
84+ where
96−-- xs = map (bimap (fromString . ('^':)) (fromString . f)) acronyms
85+ xs = map (bimap (fromString . ('^':)) (fromString . f)) acronyms
97−
86+
98−-- f (c:cs) = toLower c : cs
87+ f (c:cs) = toLower c : cs
99−-- f [] = []
88+ f [] = []
100−
89+
101−-- replaceAll :: Text -> [(Regex, Replace)] -> Text
90+replaceAll :: Text -> [(Regex, Replace)] -> Text
102−-- replaceAll = Fold.foldl' (flip (uncurry RE.replaceAll))
91+replaceAll = Fold.foldl' (flip (uncurry RE.replaceAll))
103−
92+
104−-- upperAcronym :: Text -> Text
93+upperAcronym :: Text -> Text
105−-- upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
94+upperAcronym x = Fold.foldl' (flip (uncurry RE.replaceAll)) x xs
106−-- where
95+ where
107−-- xs :: [(Regex, Replace)]
96+ xs :: [(Regex, Replace)]
108−-- xs = [ ("Acl", "ACL")
97+ xs = []
109−-- ]
98+
110−
111−-- acronyms :: [(String, String)]
99+acronyms :: [(String, String)]
112−-- acronyms =
100+acronyms = []
113−-- [ ("ACL", "Acl")
114−-- ]
gen/stack.yaml+4−2
@@ -1,4 +1,6 @@
1resolver: nightly-2015-08-06
1resolver: nightly-2015-08-06
2flags: {}
2flags: {}
3−packages: ['.']
4−extra-deps: []
3+extra-deps:
4+ - text-regex-replace-0.1.1.1
5+packages:
6+ - '.'