on develop help sign in
Adding prime suffix to all internal product data constructors
commit0185a079f3306d34eef8da0c7eda95e6ea504c43 authorBrendan Hay <brendan.g.hay@gmail.com> dateMon 21 Mar 2016, 20:47 (11 years ago) parent2299a92
2 files changed+19−17
gen/src/Gen/Syntax.hs+9−10 gen/src/Gen/Types/Id.hs+10−7
gen/src/Gen/Syntax.hs+9−10
@@ -235,7 +235,7 @@ downloadDecl n pre api url fs m =
235235 pat = downloadPat m
236236
237237 prec = PApp (UnQual "MediaDownload")
238− [ PRec (UnQual (dname n)) [PFieldWildcard | not (null fs)]
238+ [ PRec (UnQual (dname' n)) [PFieldWildcard | not (null fs)]
239239 ]
240240
241241uploadDecl :: Global
@@ -269,7 +269,7 @@ uploadDecl n pre api url fs m =
269269 pat = uploadPat m
270270
271271 prec = PApp (UnQual "MediaUpload")
272− [ PRec (UnQual (dname n)) [PFieldWildcard | not (null fs)]
272+ [ PRec (UnQual (dname' n)) [PFieldWildcard | not (null fs)]
273273 , PVar media
274274 ]
275275
@@ -304,7 +304,7 @@ requestDecl n pre api url fs m =
304304
305305 pat = metadataPat m
306306
307− prec = PRec (UnQual (dname n)) [PFieldWildcard | not (null fs)]
307+ prec = PRec (UnQual (dname' n)) [PFieldWildcard | not (null fs)]
308308
309309googleRequestDecl :: Type
310310 -> [InstDecl]
@@ -413,7 +413,7 @@ wildcardD f n enc x = \case
413413 match p es =
414414 Match noLoc (name f) [p] Nothing (UnGuardedRhs (enc es)) noBinds
415415
416− prec = PRec (UnQual (dname n)) [PFieldWildcard]
416+ prec = PRec (UnQual (dname' n)) [PFieldWildcard]
417417
418418defJS :: Local -> Exp -> Exp
419419defJS n x = infixApp (infixApp (var "o") ".:?" (fstr n)) ".!=" x
@@ -432,17 +432,16 @@ constD f x = InsDecl $
432432 sfun noLoc (name f) [] (UnGuardedRhs (app (var "const") x)) noBinds
433433
434434ctorE :: Global -> [Exp] -> Exp
435−ctorE n = seqE (var (dname n)) . map paren
435+ctorE n = seqE (var (dname' n)) . map paren
436436
437437seqE :: Exp -> [Exp] -> Exp
438438seqE l [] = app (var "pure") l
439439seqE l (r:rs) = infixApp l "<$>" (infixE r "<*>" rs)
440440
441441objDecl :: Global -> Prefix -> [Derive] -> Map Local Solved -> Decl
442−objDecl n p ds rs = DataDecl noLoc arity [] d [] [conDecl d p rs] (der ds)
442+objDecl n p ds rs =
443+ DataDecl noLoc arity [] (dname n) [] [conDecl (dname' n) p rs] (der ds)
443444 where
444− d = dname n
445−
446445 arity | Map.size rs == 1 = NewType
447446 | otherwise = DataType
448447
@@ -467,8 +466,8 @@ ctorSig n rs = TypeSig noLoc [cname n] ts
467466ctorDecl :: Global -> Prefix -> Map Local Solved -> Decl
468467ctorDecl n p rs = sfun noLoc c ps (UnGuardedRhs rhs) noBinds
469468 where
470− c = cname n
471− d = dname n
469+ c = cname n
470+ d = dname' n
472471
473472 rhs | Map.null rs = var d
474473 | otherwise = RecConstr (UnQual d) $
gen/src/Gen/Types/Id.hs+10−7
@@ -44,6 +44,7 @@ module Gen.Types.Id
4444 , aname
4545 , mname
4646 , dname
47+ , dname'
4748 , dstr
4849 , cname
4950 , bname
@@ -57,16 +58,12 @@ import Control.Applicative
5758import Control.Monad
5859import Data.Aeson hiding (Bool, String)
5960import qualified Data.Attoparsec.Text as A
60−import Data.CaseInsensitive (CI)
6161import qualified Data.CaseInsensitive as CI
62−import Data.Coerce
6362import Data.Foldable (foldl')
6463import Data.Function (on)
6564import Data.Hashable
6665import Data.List (intersperse)
6766import Data.List (elemIndex, nub, sortOn)
68−import Data.Maybe
69−import Data.Ord
7067import Data.Semigroup hiding (Sum)
7168import Data.String
7269import Data.Text (Text)
@@ -79,7 +76,7 @@ import Gen.Text
7976import Gen.Types.Map
8077import GHC.Generics (Generic)
8178import Language.Haskell.Exts.Build
82−import Language.Haskell.Exts.Syntax (Exp, Name)
79+import Language.Haskell.Exts.Syntax (Exp, Name (..))
8380
8481aname :: Text -> Name
8582aname = name . Text.unpack . (<> "API") . upperHead . Text.replace "." ""
@@ -99,6 +96,12 @@ mname abrv (Suffix suf) (Global g) =
9996 e = Text.replace "." "" abrv
10097 x:xs = map (upperAcronym . toPascal) g
10198
99+dname' :: Global -> Name
100+dname' g =
101+ case dname g of
102+ Ident s -> Ident (s <> "'")
103+ Symbol s -> Symbol (s <> "'")
104+
102105dname :: Global -> Name
103106dname = name
104107 . Text.unpack
@@ -208,12 +211,12 @@ extractPath x = either (error . err) id $ A.parseOnly path x
208211 where
209212 err e = "Error parsing \"" <> Text.unpack x <> "\", " <> e
210213
211− path = A.many1 (seg <|> repeat <|> var') <* A.endOfInput
214+ path = A.many1 (seg <|> rep <|> var') <* A.endOfInput
212215
213216 seg = fmap Left $
214217 optional (A.char '/') *> A.takeWhile1 (A.notInClass "/{+*}")
215218
216− repeat = fmap Right $ do
219+ rep = fmap Right $ do
217220 void $ A.string "{/"
218221 (,Nothing) <$> fmap Local (A.takeWhile1 (/= '*'))
219222 <* A.string "*}"