Inform Ormolu of some operator precedences

This adds a .ormolu file to tell Ormolu what some operator precedences are, to improve indentation of multi-line operator sequences.
sellout · Jul 19, 2024 · 9ac6a04 · 9ac6a04
1 parent f7633ce
commit 9ac6a04
Show file tree

Hide file tree

Showing 15 changed files with 57 additions and 86 deletions.
diff --git a/.ormolu b/.ormolu
@@ -0,0 +1,4 @@
+infixl 8 ^?
+infixr 4 %%~, %~
+infixl 3 <|>
+infixl 1 &, <&>
diff --git a/lib/unison-util-bytes/test/Main.hs b/lib/unison-util-bytes/test/Main.hs
@@ -42,10 +42,8 @@ test =
           scope "<>" . expect' $
             Bytes.toArray (b1s <> b2s <> b3s) == b1 <> b2 <> b3
           scope "Ord" . expect' $
-            (b1 <> b2 <> b3)
-              `compare` b3
-              == (b1s <> b2s <> b3s)
-                `compare` b3s
+            (b1 <> b2 <> b3) `compare` b3
+              == (b1s <> b2s <> b3s) `compare` b3s
           scope "take" . expect' $
             Bytes.toArray (Bytes.take k (b1s <> b2s)) == BS.take k (b1 <> b2)
           scope "drop" . expect' $

diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs
@@ -396,12 +396,9 @@ typeLookupForDependencies codebase s = do
     unseen :: TL.TypeLookup Symbol a -> Reference -> Bool
     unseen tl r =
       isNothing
-        ( Map.lookup r (TL.dataDecls tl)
-            $> ()
-            <|> Map.lookup r (TL.typeOfTerms tl)
-            $> ()
-            <|> Map.lookup r (TL.effectDecls tl)
-            $> ()
+        ( Map.lookup r (TL.dataDecls tl) $> ()
+            <|> Map.lookup r (TL.typeOfTerms tl) $> ()
+            <|> Map.lookup r (TL.effectDecls tl) $> ()
         )
 
 toCodeLookup :: (MonadIO m) => Codebase m Symbol Parser.Ann -> CL.CodeLookup Symbol m Parser.Ann

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase/Operations.hs
@@ -543,7 +543,7 @@ filterReferentsHavingTypeImpl ::
 filterReferentsHavingTypeImpl doGetDeclType typRef termRefs =
   Ops.filterTermsByReferentHavingType (Cv.reference1to2 typRef) (Cv.referentid1to2 <$> toList termRefs)
     >>= traverse (Cv.referentid2to1 doGetDeclType)
-      <&> Set.fromList
+    <&> Set.fromList
 
 -- | The number of base32 characters needed to distinguish any two references in the codebase.
 hashLength :: Transaction Int

diff --git a/parser-typechecker/src/Unison/Runtime/ANF.hs b/parser-typechecker/src/Unison/Runtime/ANF.hs
@@ -1911,35 +1911,31 @@ anfInitCase u (MatchCase p guard (ABT.AbsN' vs bd))
   | P.Constructor _ (ConstructorReference r t) ps <- p = do
       (,)
         <$> expandBindings ps vs
-        <*> anfBody bd <&> \(us, bd) ->
-          AccumData r Nothing
-            . EC.mapSingleton (fromIntegral t)
-            . (BX <$ us,)
-            . ABTN.TAbss us
-            $ bd
+        <*> anfBody bd
+        <&> \(us, bd) ->
+          AccumData r Nothing . EC.mapSingleton (fromIntegral t) . (BX <$ us,) $ ABTN.TAbss us bd
   | P.EffectPure _ q <- p =
       (,)
         <$> expandBindings [q] vs
-        <*> anfBody bd <&> \(us, bd) ->
-          AccumPure $ ABTN.TAbss us bd
+        <*> anfBody bd
+        <&> \(us, bd) -> AccumPure $ ABTN.TAbss us bd
   | P.EffectBind _ (ConstructorReference r t) ps pk <- p = do
       (,,)
         <$> expandBindings (snoc ps pk) vs
         <*> Compose (pure <$> fresh)
         <*> anfBody bd
-          <&> \(exp, kf, bd) ->
-            let (us, uk) =
-                  maybe (internalBug "anfInitCase: unsnoc impossible") id $
-                    unsnoc exp
-                jn = Builtin "jumpCont"
-             in flip AccumRequest Nothing
-                  . Map.singleton r
-                  . EC.mapSingleton (fromIntegral t)
-                  . (BX <$ us,)
-                  . ABTN.TAbss us
-                  . TShift r kf
-                  . TName uk (Left jn) [kf]
-                  $ bd
+        <&> \(exp, kf, bd) ->
+          let (us, uk) =
+                maybe (internalBug "anfInitCase: unsnoc impossible") id $
+                  unsnoc exp
+              jn = Builtin "jumpCont"
+           in flip AccumRequest Nothing
+                . Map.singleton r
+                . EC.mapSingleton (fromIntegral t)
+                . (BX <$ us,)
+                . ABTN.TAbss us
+                . TShift r kf
+                $ TName uk (Left jn) [kf] bd
   | P.SequenceLiteral _ [] <- p =
       AccumSeqEmpty <$> anfBody bd
   | P.SequenceOp _ l op r <- p,

diff --git a/parser-typechecker/src/Unison/Syntax/TermParser.hs b/parser-typechecker/src/Unison/Syntax/TermParser.hs
@@ -1011,12 +1011,9 @@ force = P.label "force" $ P.try do
 
 seqOp :: (Ord v) => P v m Pattern.SeqOp
 seqOp =
-  Pattern.Snoc
-    <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment)))
-      <|> Pattern.Cons
-    <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment)))
-      <|> Pattern.Concat
-    <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment)))
+  Pattern.Snoc <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.snocSegment)))
+    <|> Pattern.Cons <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.consSegment)))
+    <|> Pattern.Concat <$ matchToken (L.SymbolyId (HQ'.fromName (Name.fromSegment NameSegment.concatSegment)))
 
 term4 :: (Monad m, Var v) => TermP v m
 term4 = f <$> some termLeaf

diff --git a/parser-typechecker/src/Unison/Syntax/TermPrinter.hs b/parser-typechecker/src/Unison/Syntax/TermPrinter.hs
@@ -2016,10 +2016,8 @@ toDocSourceElement ppe (Apps' (Ref' r) [tm, toDocSourceAnnotations ppe -> Just a
       (,annotations) <$> ok tm
   where
     ok tm =
-      Right
-        <$> toDocEmbedTermLink ppe tm
-          <|> Left
-        <$> toDocEmbedTypeLink ppe tm
+      Right <$> toDocEmbedTermLink ppe tm
+        <|> Left <$> toDocEmbedTypeLink ppe tm
 toDocSourceElement _ _ = Nothing
 
 toDocSource' ::

diff --git a/parser-typechecker/src/Unison/UnisonFile.hs b/parser-typechecker/src/Unison/UnisonFile.hs
@@ -128,20 +128,10 @@ allWatches = join . Map.elems . watches
 -- | Get the location of a given definition in the file.
 definitionLocation :: (Var v) => v -> UnisonFile v a -> Maybe a
 definitionLocation v uf =
-  terms uf
-    ^? ix v
-      . _1
-      <|> watches uf
-    ^? folded
-      . folded
-      . filteredBy (_1 . only v)
-      . _2
-      <|> dataDeclarations uf
-    ^? ix v
-      . _2
-      . to DD.annotation
-      <|> effectDeclarations uf
-    ^? ix v . _2 . to (DD.annotation . DD.toDataDecl)
+  terms uf ^? ix v . _1
+    <|> watches uf ^? folded . folded . filteredBy (_1 . only v) . _2
+    <|> dataDeclarations uf ^? ix v . _2 . to DD.annotation
+    <|> effectDeclarations uf ^? ix v . _2 . to (DD.annotation . DD.toDataDecl)
 
 -- Converts a file to a single let rec with a body of `()`, for
 -- purposes of typechecking.
@@ -292,10 +282,8 @@ lookupDecl ::
   TypecheckedUnisonFile v a ->
   Maybe (Reference.Id, DD.Decl v a)
 lookupDecl v uf =
-  over _2 Right
-    <$> (Map.lookup v (dataDeclarationsId' uf))
-      <|> over _2 Left
-    <$> (Map.lookup v (effectDeclarationsId' uf))
+  over _2 Right <$> (Map.lookup v (dataDeclarationsId' uf))
+    <|> over _2 Left <$> (Map.lookup v (effectDeclarationsId' uf))
 
 indexByReference ::
   TypecheckedUnisonFile v a ->

diff --git a/parser-typechecker/src/Unison/Util/Text.hs b/parser-typechecker/src/Unison/Util/Text.hs
@@ -141,16 +141,15 @@ ordinal :: (IsString s) => Int -> s
 ordinal n = do
   let s = show n
   fromString $
-    s
-      ++ case L.drop (L.length s - 2) s of
-        ['1', '1'] -> "th"
-        ['1', '2'] -> "th"
-        ['1', '3'] -> "th"
-        _ -> case last s of
-          '1' -> "st"
-          '2' -> "nd"
-          '3' -> "rd"
-          _ -> "th"
+    s ++ case L.drop (L.length s - 2) s of
+      ['1', '1'] -> "th"
+      ['1', '2'] -> "th"
+      ['1', '3'] -> "th"
+      _ -> case last s of
+        '1' -> "st"
+        '2' -> "nd"
+        '3' -> "rd"
+        _ -> "th"
 
 -- Drop with both a maximum size and a predicate. Yields actual number of
 -- dropped characters.

diff --git a/parser-typechecker/tests/Unison/Test/Util/Text.hs b/parser-typechecker/tests/Unison/Test/Util/Text.hs
@@ -46,10 +46,8 @@ test =
           scope "<>" . expect' $
             Text.toText (t1s <> t2s <> t3s) == t1 <> t2 <> t3
           scope "Ord" . expect' $
-            (t1 <> t2 <> t3)
-              `compare` t3
-              == (t1s <> t2s <> t3s)
-                `compare` t3s
+            (t1 <> t2 <> t3) `compare` t3
+              == (t1s <> t2s <> t3s) `compare` t3s
           scope "take" . expect' $
             Text.toText (Text.take k (t1s <> t2s)) == T.take k (t1 <> t2)
           scope "drop" . expect' $

diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs
@@ -378,12 +378,12 @@ makeUnisonFile abort codebase doFindCtorNames defns = do
                 overwriteConstructorNames name ed.toDataDecl <&> \ed' ->
                   uf
                     & #effectDeclarationsId
-                    %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed')
+                      %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, Decl.EffectDeclaration ed')
               Right dd ->
                 overwriteConstructorNames name dd <&> \dd' ->
                   uf
                     & #dataDeclarationsId
-                    %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd')
+                      %~ Map.insertWith (\_new old -> old) (Name.toVar name) (Reference.Id h i, dd')
 
         -- Constructor names are bogus when pulled from the database, so we set them to what they should be here
         overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann)

diff --git a/unison-cli/src/Unison/Codebase/Editor/UriParser.hs b/unison-cli/src/Unison/Codebase/Editor/UriParser.hs
@@ -30,10 +30,8 @@ type P = P.Parsec Void Text.Text
 
 readRemoteNamespaceParser :: ProjectBranchSpecifier branch -> P (ReadRemoteNamespace (These ProjectName branch))
 readRemoteNamespaceParser specifier =
-  ReadShare'ProjectBranch
-    <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
-      <|> ReadShare'LooseCode
-    <$> readShareLooseCode
+  ReadShare'ProjectBranch <$> projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths specifier
+    <|> ReadShare'LooseCode <$> readShareLooseCode
 
 projectAndBranchNamesParserInTheContextOfAlsoParsingLooseCodePaths ::
   ProjectBranchSpecifier branch ->

diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs
@@ -256,7 +256,7 @@ formatStructuredArgument schLength = \case
       BranchAtProjectPath pp ->
         pp
           & PP.absPath_
-          %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name))
+            %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name))
           & PP.toNames
           & into @Text
 
@@ -507,7 +507,7 @@ handleBranchIdArg =
           BranchAtProjectPath pp ->
             pp
               & PP.absPath_
-              %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name))
+                %~ (\pathPrefix -> Path.resolve pathPrefix (Path.fromName name))
               & BranchAtProjectPath
       SA.Namespace hash -> pure . BranchAtSCH $ SCH.fromFullHash hash
       otherNumArg -> Left $ wrongStructuredArgument "a branch id" otherNumArg

diff --git a/unison-core/src/Unison/ABT.hs b/unison-core/src/Unison/ABT.hs
@@ -154,8 +154,7 @@ baseFunctor_ ::
   m (Term f v a)
 baseFunctor_ f t =
   t
-    & abt_
-    %%~ \case
+    & abt_ %%~ \case
       Tm fx -> Tm <$> f (fx)
       x -> pure x
 

diff --git a/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs b/unison-merge/src/Unison/Merge/PartitionCombinedDiffs.hs
@@ -97,8 +97,7 @@ identifyConflicts declNameLookups defns =
             typeConflicts <- Map.upsertF (maybe (Just ref) (const Nothing)) name (view myTypeConflicts_ s)
             Just $
               s
-                & myTypeConflicts_
-                .~ typeConflicts
+                & myTypeConflicts_ .~ typeConflicts
                 & case ref of
                   ReferenceBuiltin _ -> id -- builtin types don't have constructors
                   ReferenceDerived _ -> theirTermStack_ %~ (expectConstructorNames myDeclNameLookup name ++)