Merge pull request #1021 from endgame/gen-tidyups

Gen tidyups

.hlint.yaml

@@ -1,3 +1,9 @@
+# ($) is heavily used in Gen.Tree to force ormolu to make a better layout
+- ignore:
+    name: "Redundant $"
+    within:
+      - Gen.Tree
+
 # Ignore camel-case warnings for modules containing explicit lenses
 - ignore:
     name: "Use camelCase"

gen/bin/gen-configs.hs

@@ -57,9 +57,9 @@ main = do
       annexDir = configDir </> "annexes"
 
   frequencies <-
-    fmap Gen.WordFrequency.newTable (ByteString.readFile wordFrequencies) >>= \case
-      Left err -> UnliftIO.throwString err
-      Right ok -> pure ok
+    either UnliftIO.throwString pure
+      . Gen.WordFrequency.newTable
+      =<< ByteString.readFile wordFrequencies
 
   available <- Set.fromList <$> getAvailable botocoreDir
   configured <- Set.fromList <$> getConfigured serviceDir

gen/src/Gen/AST/Data.hs

@@ -27,7 +27,7 @@ import qualified Language.Haskell.Exts as Exts
 import Language.Haskell.Exts.Pretty (Pretty)
 
 operationData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   Config ->
   a ->
   Operation Identity Ref (Pager Id) ->
@@ -50,8 +50,8 @@ operationData cfg m o = do
       . HashMap.insert "AWSRequest" cls
       <$> renderInsts p xn xis
 
-  pure
-    $! o
+  pure $!
+    o
       { _opInput = Identity $ Prod (xa & relShared .~ 0) xd xis',
         _opOutput = Identity $ Prod ya yd yis'
       }
@@ -72,7 +72,7 @@ operationData cfg m o = do
     yn = identifier yr
 
 shapeData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Shape Solved ->
   Either String (Maybe SData)
@@ -88,7 +88,7 @@ shapeData m (a :< s) = case s of
     p = m ^. protocol
     r = a ^. relMode
 
-addInstances :: TypeOf a => a -> [Field] -> [Inst] -> [Inst]
+addInstances :: (TypeOf a) => a -> [Field] -> [Inst] -> [Inst]
 addInstances s fs =
   cons isHashable (IsHashable fs)
     . cons isNFData (IsNFData fs)
@@ -98,7 +98,7 @@ addInstances s fs =
       | otherwise = id
 
 errorData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Solved ->
   Info ->
@@ -163,7 +163,7 @@ sumData p s i vs = Sum s <$> mk <*> fmap HashMap.keys insts
     n = s ^. annId
 
 prodData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Solved ->
   StructF (Shape Solved) ->
@@ -258,7 +258,8 @@ prodData m s st = (,fields) <$> mk
       pp None $
         Exts.Deriving () Nothing $
           map (Exts.IRule () Nothing Nothing) $
-            mapMaybe deriveInstHead $ derivingOf s
+            mapMaybe deriveInstHead $
+              derivingOf s
 
     deriveInstHead :: Derive -> Maybe (Exts.InstHead ())
     deriveInstHead d = do
@@ -305,8 +306,8 @@ prodData m s st = (,fields) <$> mk
 
     dependencies = foldMap go fields
       where
-        go :: TypeOf a => a -> Set.Set Text
-        go f = case (typeOf f) of
+        go :: (TypeOf a) => a -> Set.Set Text
+        go f = case typeOf f of
           TType x _ -> tTypeDep x
           TLit _ -> Set.empty
           TNatural -> Set.empty
@@ -319,7 +320,7 @@ prodData m s st = (,fields) <$> mk
 
         tTypeDep :: Text -> Set.Set Text
         tTypeDep x =
-          if (stripped /= typeId n)
+          if stripped /= typeId n
             then Set.singleton stripped
             else Set.empty
           where
@@ -333,7 +334,7 @@ renderInsts p n = fmap HashMap.fromList . traverse go
     go i = (instToText i,) <$> pp Print (instanceD p n i)
 
 serviceData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Retry ->
   Either String Fun
@@ -352,7 +353,7 @@ serviceData m r =
           <> " configuration."
 
 waiterData ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   HashMap Id (Operation Identity Ref b) ->
   Id ->
@@ -370,7 +371,8 @@ waiterData m os n w = do
   pure $! WData (typeId n) (_opName o) c
   where
     missingErr i xs =
-      "Missing operation " ++ Text.unpack (memberId i)
+      "Missing operation "
+        ++ Text.unpack (memberId i)
         ++ " when rendering waiter "
         ++ ", possible matches: "
         ++ partial i xs
@@ -391,7 +393,7 @@ waiterData m os n w = do
     key = _waitOperation w
 
 waiterFields ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Operation Identity Ref b ->
   Waiter Id ->
@@ -406,7 +408,7 @@ waiterFields m o = Lens.traverseOf (waitAcceptors . Lens.each) go
       pure $! x & acceptArgument .~ n
 
 pagerFields ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Operation Identity Ref (Pager Id) ->
   Either String (Maybe (Pager Field))
@@ -428,7 +430,7 @@ pagerFields m o = traverse go (o ^. opPager)
         <*> notation m out y
 
 notation ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   a ->
   Shape Solved ->
   Notation Id ->
@@ -493,9 +495,8 @@ data PP
   | None
   deriving stock (Eq)
 
-pp :: Pretty a => PP -> a -> Either String Rendered
-pp i d
-  | otherwise = pure (Text.Lazy.fromStrict (Text.Encoding.decodeUtf8 printed))
+pp :: (Pretty a) => PP -> a -> Either String Rendered
+pp i d = pure (Text.Lazy.fromStrict (Text.Encoding.decodeUtf8 printed))
   where
     printed =
       ByteString.Char8.dropWhile Char.isSpace . ByteString.Char8.pack $
@@ -508,9 +509,9 @@ pp i d
           Exts.ribbonsPerLine = 1.5
         }
 
-    mode
-      | i == Print = Exts.defaultMode
-      | otherwise =
+    mode = case i of
+      Print -> Exts.defaultMode
+      None ->
         Exts.defaultMode
           { Exts.layout = Exts.PPNoLayout,
             Exts.spacing = False

gen/src/Gen/AST/Data/Syntax.hs

@@ -84,7 +84,7 @@ toXMap, toQMap :: Exp
 toXMap = var "Data.toXMLMap"
 toQMap = var "Data.toQueryMap"
 
-ctorS :: HasMetadata a Identity => a -> Id -> [Field] -> Decl
+ctorS :: (HasMetadata a Identity) => a -> Id -> [Field] -> Decl
 ctorS m n fs = Exts.TypeSig () [ident (smartCtorId n)] ty
   where
     ty = foldr (Exts.TyFun ()) (tycon (typeId n)) ps
@@ -111,7 +111,7 @@ fieldUpdate f = field (unqual (fieldAccessor f)) rhs
 
     pat = Exts.Var () (Exts.UnQual () (fieldParamName f))
 
-lensS :: HasMetadata a Identity => a -> TType -> Field -> Decl
+lensS :: (HasMetadata a Identity) => a -> TType -> Field -> Decl
 lensS m type' f =
   Exts.TypeSig () [ident (fieldLens f)] $
     tyapp
@@ -147,7 +147,7 @@ errorS n =
           `tyapp` tyvar "a"
           `tyapp` tycon "Core.ServiceError"
 
-errorD :: HasMetadata a Identity => a -> Text -> Maybe Int -> Text -> Decl
+errorD :: (HasMetadata a Identity) => a -> Text -> Maybe Int -> Text -> Decl
 errorD m n s c =
   Exts.sfun (ident n) [] (unguarded (maybe rhs status s)) Exts.noBinds
   where
@@ -177,7 +177,7 @@ dataD n fs cs = Exts.DataDecl () arity Nothing head' fs [derives]
     rule c =
       Exts.IRule () Nothing Nothing (Exts.IHCon () (unqual c))
 
-recordD :: HasMetadata a Identity => a -> Id -> [Field] -> QualConDecl
+recordD :: (HasMetadata a Identity) => a -> Id -> [Field] -> QualConDecl
 recordD m n =
   conD . \case
     [] -> Exts.ConDecl () c []
@@ -191,10 +191,10 @@ recordD m n =
 conD :: ConDecl -> QualConDecl
 conD = Exts.QualConDecl () Nothing Nothing
 
-serviceS :: HasMetadata a Identity => a -> Decl
+serviceS :: (HasMetadata a Identity) => a -> Decl
 serviceS m = Exts.TypeSig () [ident (m ^. serviceConfig)] (tycon "Core.Service")
 
-serviceD :: HasMetadata a Identity => a -> Retry -> Decl
+serviceD :: (HasMetadata a Identity) => a -> Retry -> Decl
 serviceD m r = Exts.patBindWhere (pvar n) rhs bs
   where
     bs = [try Exts.noBinds, chk Exts.noBinds]
@@ -345,7 +345,7 @@ notationE' withLensIso = \case
     accessors f
       | not withLensIso = var (fieldLens f)
       | otherwise =
-          foldl' (\a b -> Exts.infixApp a "Prelude.." b) (var (fieldLens f)) $
+          foldl' (`Exts.infixApp` "Prelude..") (var (fieldLens f)) $
             lensIso (typeOf f)
 
     lensIso = \case
@@ -354,7 +354,7 @@ notationE' withLensIso = \case
       _other -> []
 
 requestD ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   Config ->
   a ->
   HTTP ->
@@ -465,7 +465,7 @@ hashableD n fs =
           foldl' hashWithSaltE (Exts.var "_salt") $
             var . fieldAccessor <$> fs
 
-    hashWithSaltE l r = Exts.infixApp l "`Prelude.hashWithSalt`" r
+    hashWithSaltE = (`Exts.infixApp` "`Prelude.hashWithSalt`")
 
 nfDataD :: Id -> [Field] -> Decl
 nfDataD n fs =
@@ -481,9 +481,9 @@ nfDataD n fs =
       Nothing -> Exts.tuple []
       Just rnfs -> foldr1 seqE rnfs
 
-    rnfE = Exts.app (var "Prelude.rnf")
+    rnfE = (var "Prelude.rnf" `Exts.app`)
 
-    seqE l r = Exts.infixApp l "`Prelude.seq`" r
+    seqE = (`Exts.infixApp` "`Prelude.seq`")
 
 -- FIXME: merge D + E constructors where possible
 fromXMLD :: Protocol -> Id -> [Field] -> Decl
@@ -787,7 +787,7 @@ inputNames p f = Proto.nestedNames p Input (f ^. fieldId) (f ^. fieldRef)
 outputNames p f = Proto.nestedNames p Output (f ^. fieldId) (f ^. fieldRef)
 
 requestF ::
-  HasMetadata a Identity =>
+  (HasMetadata a Identity) =>
   Config ->
   a ->
   HTTP ->
@@ -840,7 +840,7 @@ responseF p r fs
   | any fieldStream fs = var "Response.receiveBody"
   | any fieldLitPayload fs = var "Response.receiveBytes"
   | Just x <- r ^. refResultWrapper = Exts.app (var (suf <> "Wrapper")) (str x)
-  | all (not . fieldBody) fs = var "Response.receiveEmpty"
+  | not $ any fieldBody fs = var "Response.receiveEmpty"
   | otherwise = var suf
   where
     suf = "Response.receive" <> Proto.suffix p
@@ -901,10 +901,10 @@ waiterD n w = Exts.sfun (ident c) [] (unguarded rhs) Exts.noBinds
             \y -> Exts.infixApp y "Prelude.." (Exts.app (var "Lens.to") (var "Data.toTextCI"))
           _ -> id
 
-signature :: HasMetadata a Identity => a -> TType -> Type
+signature :: (HasMetadata a Identity) => a -> TType -> Type
 signature m = directed False m Nothing
 
-internal, external :: HasMetadata a Identity => a -> Field -> Type
+internal, external :: (HasMetadata a Identity) => a -> Field -> Type
 internal m f = directed True m (_fieldDirection f) f
 external m f = directed False m (_fieldDirection f) f