@@ -9,7 +9,7 @@ module Language.Haskell.Stylish.Step.SimpleAlign
99
1010--------------------------------------------------------------------------------
1111import Control.Monad (guard )
12- import Data.List (foldl' )
12+ import Data.List (foldl' , foldl1' )
1313import Data.Maybe (fromMaybe )
1414import qualified GHC.Hs as Hs
1515import qualified SrcLoc as S
@@ -134,6 +134,39 @@ matchToAlignable _conf (S.L _ (Hs.XMatch x)) = Hs.noExtCon x
134134matchToAlignable _conf (S. L _ (Hs. Match _ _ _ _)) = Nothing
135135
136136
137+ --------------------------------------------------------------------------------
138+ multiWayIfToAlignable
139+ :: Config
140+ -> Hs. LHsExpr Hs. GhcPs
141+ -> [Alignable S. RealSrcSpan ]
142+ multiWayIfToAlignable conf (S. L _ (Hs. HsMultiIf _ grhss)) =
143+ fromMaybe [] $ traverse (grhsToAlignable conf) grhss
144+ multiWayIfToAlignable _conf _ = []
145+
146+
147+ --------------------------------------------------------------------------------
148+ grhsToAlignable
149+ :: Config
150+ -> S. Located (Hs. GRHS Hs. GhcPs (Hs. LHsExpr Hs. GhcPs ))
151+ -> Maybe (Alignable S. RealSrcSpan )
152+ grhsToAlignable conf (S. L grhsloc (Hs. GRHS _ guards@ (_ : _) body)) = do
153+ guard $ cCases conf
154+ let guardsLocs = map S. getLoc guards
155+ bodyLoc = S. getLoc body
156+ left = foldl1' S. combineSrcSpans guardsLocs
157+ matchPos <- toRealSrcSpan grhsloc
158+ leftPos <- toRealSrcSpan left
159+ bodyPos <- toRealSrcSpan bodyLoc
160+ Just $ Alignable
161+ { aContainer = matchPos
162+ , aLeft = leftPos
163+ , aRight = bodyPos
164+ , aRightLead = length " -> "
165+ }
166+ grhsToAlignable _conf (S. L _ (Hs. XGRHS x)) = Hs. noExtCon x
167+ grhsToAlignable _conf (S. L _ _) = Nothing
168+
169+
137170--------------------------------------------------------------------------------
138171step :: Maybe Int -> Config -> Step
139172step maxColumns config = makeStep " Cases" $ \ ls module' ->
@@ -147,5 +180,6 @@ step maxColumns config = makeStep "Cases" $ \ls module' ->
147180 configured :: [Change String ]
148181 configured = concat $
149182 [changes records recordToAlignable | cRecords config] ++
150- [changes everything (matchGroupToAlignable config)] in
183+ [changes everything (matchGroupToAlignable config)] ++
184+ [changes everything (multiWayIfToAlignable config)] in
151185 applyChanges configured ls
0 commit comments