Add function-arrows=leading-args option

README.md

@@ -46,7 +46,7 @@ Defaults are in bold.
 | Configuration option     | Valid options                                         | Description
 |--------------------------|-------------------------------------------------------|-------------
 | `indentation`            | any non-negative integer (**`4`**)                    | How many spaces to use as an indent
-| `function-arrows`        | **`trailing`**, `leading`                             | Where to place arrows in type signatures
+| `function-arrows`        | **`trailing`**, `leading`, `leading-args`             | Where to place arrows in type signatures
 | `comma-style`            | **`leading`**, `trailing`                             | Where to place commas in lists, tuples, etc.
 | `import-export-style`    | `leading`, `trailing`, **`diff-friendly`**            | How to format multiline import/export lists (`diff-friendly` lists have trailing commas but keep the opening parenthesis on the same line as `import`)
 | `indent-wheres`          | `true`, **`false`**                                   | Use an extra level of indentation _vs_ only half-indent the `where` keyword

changelog.d/function-arrows-leading-args.md

@@ -0,0 +1 @@
+New `leading-args` option to `function-arrows` configuration that allows leading arrows only for function arguments ([#233](https://github.com/fourmolu/fourmolu/issues/233))

data/fourmolu/function-arrows/output-LeadingArgsArrows.hs

@@ -0,0 +1,129 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE LinearTypes #-}
+
+module Main where
+
+-- | Something else.
+class Bar a where
+    -- | Bar
+    bar ::
+        String
+        -> String
+        -> a
+    -- Pointless comment
+    default bar ::
+        ( Read a
+        , Semigroup a
+        ) =>
+        a
+        -> a
+        -> a
+    -- Even more pointless comment
+    bar
+        a
+        b =
+            read a <> read b
+
+-- | Here goes a comment.
+data Foo a where
+    -- | 'Foo' is wonderful.
+    Foo ::
+        forall a b.
+        (Show a, Eq b) => -- foo
+        -- bar
+        a
+        -> b
+        -> Foo 'Int
+    -- | But 'Bar' is also not too bad.
+    Bar ::
+        Int
+        -- ^ An Int
+        -> Maybe Text
+        -- ^ And a Maybe Text
+        -> Foo 'Bool
+    -- | So is 'Baz'.
+    Baz ::
+        forall a.
+        a
+        -> Foo 'String
+    (:~>) :: Foo a -> Foo a -> Foo a
+
+-- Single line type signature is preserved
+instance Eq Int where
+    (==) :: Int -> Int -> Bool
+    (==) _ _ = False
+singleLineFun :: forall a. (C1, C2) => Int -> Bool
+
+instance Ord Int where
+    compare ::
+        Int
+        -> Int
+        -> Ordering
+    compare
+        _
+        _ =
+            GT
+
+functionName ::
+    (C1, C2, C3, C4, C5) =>
+    a
+    -> b
+    -> ( forall a.
+         (C6, C7) =>
+         LongDataTypeName
+         -> a
+         -> AnotherLongDataTypeName
+         -> b
+         -> c
+       )
+    -> (c -> d)
+    -> (a, b, c, d)
+functionWithInterleavedCommentsTrailing ::
+    -- arg
+    Int
+    -- result
+    -> Bool
+functionWithInterleavedCommentsLeading ::
+    -- arg
+    Int
+    -- result
+    -> Bool
+
+multilineExprSig = do
+    bar
+        ( x ::
+            Int
+            -> Bool
+        )
+    bar
+        ( x ::
+            -- arg
+            Int
+            -- result
+            -> Bool
+        )
+    bar
+        ( x ::
+            -- arg
+            Int
+            -- result
+            -> Bool
+        )
+
+data Record = Record
+    { recFun ::
+        forall a.
+        (C1, C2) =>
+        Int
+        -> Int
+        -> Bool
+    , recOther :: Bool
+    }
+
+foo ::
+    Int
+    %1 -> Bool
+foo ::
+    forall x.
+    Int
+    %Many -> Bool

src/Ormolu/Config.hs

@@ -428,7 +428,8 @@ functionArrowsStyleMap :: BijectiveMap FunctionArrowsStyle
 functionArrowsStyleMap =
   $( mkBijectiveMap
       [ ('TrailingArrows, "trailing"),
-        ('LeadingArrows, "leading")
+        ('LeadingArrows, "leading"),
+        ('LeadingArgsArrows, "leading-args")
       ]
    )
 

src/Ormolu/Config/Types.hs

@@ -55,6 +55,7 @@ data CommaStyle
 data FunctionArrowsStyle
   = TrailingArrows
   | LeadingArrows
+  | LeadingArgsArrows
   deriving (Eq, Show, Enum, Bounded)
 
 data HaddockPrintStyle

src/Ormolu/Printer/Meat/Type.hs

@@ -45,6 +45,7 @@ p_hsType t = do
     getPrinterOpt poFunctionArrows >>= \case
       TrailingArrows -> pure PipeStyle
       LeadingArrows -> pure CaretStyle
+      LeadingArgsArrows -> pure CaretStyle
   layout <- getLayout
   p_hsType' (hasDocStrings t || layout == MultiLine) s t
 
@@ -72,6 +73,7 @@ p_hsType' multilineArgs docStyle = \case
     getPrinterOpt poFunctionArrows >>= \case
       LeadingArrows -> interArgBreak >> token'darrow >> space
       TrailingArrows -> space >> token'darrow >> interArgBreak
+      LeadingArgsArrows -> space >> token'darrow >> interArgBreak
     case unLoc t of
       HsQualTy {} -> p_hsTypeR (unLoc t)
       HsFunTy {} -> p_hsTypeR (unLoc t)
@@ -122,6 +124,7 @@ p_hsType' multilineArgs docStyle = \case
     getPrinterOpt poFunctionArrows >>= \case
       LeadingArrows -> interArgBreak >> located y (\y' -> p_arrow >> space >> p_hsTypeR y')
       TrailingArrows -> space >> p_arrow >> interArgBreak >> located y p_hsTypeR
+      LeadingArgsArrows -> interArgBreak >> located y (\y' -> p_arrow >> space >> p_hsTypeR y')
   HsListTy _ t ->
     located t (brackets N . p_hsType)
   HsTupleTy _ tsort xs ->
@@ -249,6 +252,11 @@ startTypeAnnotation' breakTrailing breakLeading lItem renderItem =
         token'dcolon
         space
         renderItem item
+    LeadingArgsArrows -> do
+      space
+      token'dcolon
+      breakTrailing
+      located lItem renderItem
 
 -- | Return 'True' if at least one argument in 'HsType' has a doc string
 -- attached to it.
@@ -336,6 +344,11 @@ p_conDeclField ConDeclField {..} = do
       token'dcolon
       breakpoint
       sitcc . inci $ p_hsType (unLoc cd_fld_type)
+    LeadingArgsArrows -> do
+      space
+      token'dcolon
+      breakpoint
+      sitcc . inci $ p_hsType (unLoc cd_fld_type)
   when (commaStyle == Leading) $
     mapM_ (inciByFrac (-1) . (newline >>) . p_hsDoc Caret False) cd_fld_doc