@@ -1,146 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE LambdaCase #-}
3−{-# LANGUAGE OverloadedStrings #-}
4−{-# LANGUAGE RankNTypes #-}
5−{-# LANGUAGE TemplateHaskell #-}
6−{-# LANGUAGE TypeOperators #-}
7−
8−-- Module : Gen.Prefix
9−-- Copyright : (c) 2015 Brendan Hay
10−-- License : Mozilla Public License, v. 2.0.
11−-- Maintainer : Brendan Hay <brendan.g.hay@gmail.com>
12−-- Stability : provisional
13−-- Portability : non-portable (GHC extensions)
14−
15−module Gen.Prefix where
16−
17−-- type Seen = Map (CI Text) (Set (CI Text))
18−
19−-- data Env = Env
20−-- { _memo :: Map Id (Maybe Text)
21−-- , _branches :: Seen
22−-- , _fields :: Seen
23−-- }
24−
25−-- makeLenses ''Env
26−
27−-- type MemoP = StateT Env (Either Error)
28−
29−-- prefixes :: Map Id (Shape Related) -> Either Error (Map Id (Shape Prefixed))
30−-- prefixes ss = evalStateT (traverse assignPrefix ss) env
31−-- where
32−-- env = Env mempty mempty (smartCtors ss)
33−
34−-- -- | Record projected smart constructors in set of seen field names.
35−-- smartCtors :: Map Id (Shape a) -> Seen
36−-- smartCtors = Map.fromListWith (<>) . mapMaybe go . Map.toList
37−-- where
38−-- go :: (Id, Shape a) -> Maybe (CI Text, Set (CI Text))
39−-- go (s, _ :< Struct {}) = Just (k, Set.singleton v)
40−-- where
41−-- n = smartCtorId s
42−-- k = CI.mk (Text.takeWhile isLower n)
43−-- v = CI.mk (dropLower n)
44−-- go _ = Nothing
45−
46−-- assignPrefix :: Shape Related -> MemoP (Shape Prefixed)
47−-- assignPrefix = annotate Prefixed memo go
48−-- where
49−-- go :: (HasId a, HasRelation a) => Shape a -> MemoP (Maybe Text)
50−-- go (x :< s) =
51−-- let n = typeId (identifier x)
52−-- r = x ^. relation
53−-- in case s of
54−-- Enum _ vs -> Just <$> do
55−-- let hs = mempty : acronymPrefixes r n
56−-- ks = keys vs
57−-- unique r branches n hs ks
58−
59−-- Struct st -> Just <$> do
60−-- let hs = acronymPrefixes r n
61−-- ks = keys (st ^. members)
62−-- unique r fields n hs ks
63−
64−-- _ -> return Nothing
65−
66−-- unique :: Relation
67−-- -> Lens' Env Seen
68−-- -> Text
69−-- -> [CI Text]
70−-- -> Set (CI Text)
71−-- -> MemoP Text
72−-- unique r seen n [] ks = do
73−-- s <- use seen
74−-- let hs = acronymPrefixes r n
75−-- f x = sformat ("\n" % soriginal % " => " % shown) x (Map.lookup x s)
76−-- throwError $
77−-- format ("Error prefixing: " % stext %
78−-- ", fields: " % shown %
79−-- scomma)
80−-- n (Set.toList ks) (map f hs)
81−
82−-- unique r seen n (h:hs) ks = do
83−-- m <- uses seen (Map.lookup h)
84−-- -- Find if this particular naming heuristic is used already, and if
85−-- -- it is, then is there overlap with this set of ks?
86−-- case m of
87−-- Just ys | overlap ys ks
88−-- -> unique r seen n hs ks
89−-- _ -> do
90−-- seen %= Map.insertWith (<>) h ks
91−-- return (CI.original h)
92−
93−-- overlap :: (Eq a, Hashable a) => Set a -> Set a -> Bool
94−-- overlap xs ys = not . Set.null $ Set.intersection xs ys
95−
96−-- keys :: Map Id a -> Set (CI Text)
97−-- keys = Set.fromList . map (CI.mk . typeId) . Map.keys
98−
99−-- | Acronym preference list.
100−--
101−-- Prefixing occurs as follows:
102−-- * Requests - prefer acronyms
103−-- * Responses - prefer acronyms, and append 'rs'
104−-- * Shapes - prefer single letters, then acronyms
105−-- acronymPrefixes :: Id -> Id -- Text]
106−-- acronymPrefixes n =
107−-- where
108−-- -- rs = map (<> "rs") ss
109−-- ss = xs ++ map suffix ys
110−
111−-- -- Take the next char
112−-- suffix x = Text.snoc x c
113−-- where
114−-- c | Text.length x >= 2 = Text.head (Text.drop 1 x)
115−-- | otherwise = Text.head x
116−
117−-- xs = catMaybes [r1, r2, r3, r4, r5, r6]
118−-- ys = catMaybes [r1, r2, r3, r4, r6]
119−
120−-- a = camelAcronym n
121−-- a' = upperAcronym n
122−
123−-- limit = 3
124−
125−-- -- Full name if leq limit
126−-- r1 | Text.length n <= limit = Just n
127−-- | otherwise = Nothing
128−
129−-- -- VpcPeeringInfo -> VPI
130−-- r2 = toAcronym a
131−
132−-- -- VpcPeeringInfo -> VPCPI
133−-- r3 | x /= r2 = x
134−-- | otherwise = Nothing
135−-- where
136−-- x = toAcronym a'
137−
138−-- -- SomeTestTType -> S
139−-- r4 = Text.toUpper <$> safeHead n
140−
141−-- -- SomeTypes -> STS (retain pural)
142−-- r5 | Text.isSuffixOf "s" n = flip Text.snoc 's' <$> (r2 <|> r3)
143−-- | otherwise = Nothing
144−
145−-- -- SomeTestTType -> Som
146−-- r6 = Text.take limit <$> listToMaybe (splitWords a)