Fix ticked type operator losing tick (fixes #125)

src-literatetests/15-regressions.blt

@@ -524,3 +524,6 @@ spanKey p q = case minViewWithKey q of
   Just ((k, _), q') | p k ->
     let (kas, q'') = spanKey p q' in ((k, a) : kas, q'')
   _ -> ([], q)
+
+#test issue 125
+a :: () ':- ()

src/Language/Haskell/Brittany/Internal/LayouterBasics.hs

@@ -4,6 +4,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , lrdrNameToText
   , lrdrNameToTextAnn
   , lrdrNameToTextAnnTypeEqualityIsSpecial
+  , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
   , askIndent
   , extractAllComments
   , filterAnns
@@ -216,6 +217,27 @@ lrdrNameToTextAnnTypeEqualityIsSpecial ast = do
     then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
     else x
 
+-- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects
+-- the annotations for a (parent) node for a tick to be added to the
+-- literal.
+-- Excessively long name to reflect on us having to work around such
+-- excessively obscure special cases in the exactprint API.
+lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick
+  :: ( Data ast
+     , MonadMultiReader Config m
+     , MonadMultiReader (Map AnnKey Annotation) m
+     )
+  => Located ast
+  -> Located RdrName
+  -> m Text
+lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick ast1 ast2 = do
+  hasQuote <- hasAnnKeyword ast1 AnnSimpleQuote
+  x        <- lrdrNameToTextAnn ast2
+  let lit = if x == Text.pack "Data.Type.Equality~"
+        then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh
+        else x
+  return $ if hasQuote then Text.cons '\'' lit else lit
+
 askIndent :: (MonadMultiReader Config m) => m Int
 askIndent = confUnpack . _lconfig_indentAmount . _conf_layout <$> mAsk
 

src/Language/Haskell/Brittany/Internal/Layouters/Type.hs

@@ -317,7 +317,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
   HsAppsTy [L _ (HsAppPrefix typ1)] -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     typeDoc1
-  HsAppsTy [_lname@(L _ (HsAppInfix name))] -> do
+  HsAppsTy [lname@(L _ (HsAppInfix name))] -> do
     -- this redirection is somewhat hacky, but whatever.
     -- TODO: a general problem when doing deep inspections on
     --       the type (and this is not the only instance)
@@ -326,7 +326,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
     --       circumstances exactly important annotations (comments)
     --       would be assigned to such constructors.
     typeDoc1 <- -- docSharedWrapper layoutType $ (L l $ HsTyVar name)
-      lrdrNameToTextAnnTypeEqualityIsSpecial name
+      lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lname name
     docLit typeDoc1
   HsAppsTy (L _ (HsAppPrefix typHead):typRestA)
     | Just typRest <- mapM (\case L _ (HsAppPrefix t) -> Just t
@@ -350,7 +350,8 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
       ]
     where
       layoutAppType (L _ (HsAppPrefix t)) = layoutType t
-      layoutAppType (L _ (HsAppInfix t))  = docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecial t
+      layoutAppType lt@(L _ (HsAppInfix t)) =
+        docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t
   HsListTy typ1 -> do
     typeDoc1 <- docSharedWrapper layoutType typ1
     docAlt