{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Language.Haskell.Stylish.Step.SimpleAlign
( Config (..)
, Align (..)
, defaultConfig
, step
) where
import Data.Either (partitionEithers)
import Data.Foldable (toList)
import Data.List (foldl', foldl1', sortOn)
import Data.Maybe (fromMaybe)
import qualified GHC.Hs as Hs
import qualified SrcLoc as S
import Language.Haskell.Stylish.Align
import Language.Haskell.Stylish.Editor
import Language.Haskell.Stylish.Module
import Language.Haskell.Stylish.Step
import Language.Haskell.Stylish.Util
data Config = Config
{ Config -> Align
cCases :: Align
, Config -> Align
cTopLevelPatterns :: Align
, Config -> Align
cRecords :: Align
, Config -> Align
cMultiWayIf :: Align
} deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show)
data Align
= Always
| Adjacent
| Never
deriving (Align -> Align -> Bool
(Align -> Align -> Bool) -> (Align -> Align -> Bool) -> Eq Align
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Align -> Align -> Bool
$c/= :: Align -> Align -> Bool
== :: Align -> Align -> Bool
$c== :: Align -> Align -> Bool
Eq, Int -> Align -> ShowS
[Align] -> ShowS
Align -> String
(Int -> Align -> ShowS)
-> (Align -> String) -> ([Align] -> ShowS) -> Show Align
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Align] -> ShowS
$cshowList :: [Align] -> ShowS
show :: Align -> String
$cshow :: Align -> String
showsPrec :: Int -> Align -> ShowS
$cshowsPrec :: Int -> Align -> ShowS
Show)
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: Align -> Align -> Align -> Align -> Config
Config
{ cCases :: Align
cCases = Align
Always
, cTopLevelPatterns :: Align
cTopLevelPatterns = Align
Always
, cRecords :: Align
cRecords = Align
Always
, cMultiWayIf :: Align
cMultiWayIf = Align
Always
}
groupAlign :: Align -> [Alignable S.RealSrcSpan] -> [[Alignable S.RealSrcSpan]]
groupAlign :: Align -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
groupAlign Align
a [Alignable RealSrcSpan]
xs = case Align
a of
Align
Never -> []
Align
Adjacent -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
byLine ([Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]])
-> ([Alignable RealSrcSpan] -> [Alignable RealSrcSpan])
-> [Alignable RealSrcSpan]
-> [[Alignable RealSrcSpan]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignable RealSrcSpan -> Int)
-> [Alignable RealSrcSpan] -> [Alignable RealSrcSpan]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (RealSrcSpan -> Int
S.srcSpanStartLine (RealSrcSpan -> Int)
-> (Alignable RealSrcSpan -> RealSrcSpan)
-> Alignable RealSrcSpan
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aLeft) ([Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]])
-> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
forall a b. (a -> b) -> a -> b
$ [Alignable RealSrcSpan]
xs
Align
Always -> [[Alignable RealSrcSpan]
xs]
where
byLine :: [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
byLine = (NonEmpty (Alignable RealSrcSpan) -> [Alignable RealSrcSpan])
-> [NonEmpty (Alignable RealSrcSpan)] -> [[Alignable RealSrcSpan]]
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty (Alignable RealSrcSpan) -> [Alignable RealSrcSpan]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ([NonEmpty (Alignable RealSrcSpan)] -> [[Alignable RealSrcSpan]])
-> ([Alignable RealSrcSpan] -> [NonEmpty (Alignable RealSrcSpan)])
-> [Alignable RealSrcSpan]
-> [[Alignable RealSrcSpan]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Alignable RealSrcSpan -> RealSrcSpan)
-> [Alignable RealSrcSpan] -> [NonEmpty (Alignable RealSrcSpan)]
forall a. (a -> RealSrcSpan) -> [a] -> [NonEmpty a]
groupByLine Alignable RealSrcSpan -> RealSrcSpan
forall a. Alignable a -> a
aLeft
type Record = [S.Located (Hs.ConDeclField Hs.GhcPs)]
records :: S.Located (Hs.HsModule Hs.GhcPs) -> [Record]
records :: Located (HsModule GhcPs) -> [Record]
records Located (HsModule GhcPs)
modu = do
let decls :: [HsDecl GhcPs]
decls = (LHsDecl GhcPs -> HsDecl GhcPs)
-> [LHsDecl GhcPs] -> [HsDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LHsDecl GhcPs -> HsDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
S.unLoc (HsModule GhcPs -> [LHsDecl GhcPs]
forall pass. HsModule pass -> [LHsDecl pass]
Hs.hsmodDecls (Located (HsModule GhcPs) -> SrcSpanLess (Located (HsModule GhcPs))
forall a. HasSrcSpan a => a -> SrcSpanLess a
S.unLoc Located (HsModule GhcPs)
modu))
tyClDecls :: [TyClDecl GhcPs]
tyClDecls = [ TyClDecl GhcPs
tyClDecl | Hs.TyClD XTyClD GhcPs
_ TyClDecl GhcPs
tyClDecl <- [HsDecl GhcPs]
decls ]
dataDecls :: [TyClDecl GhcPs]
dataDecls = [ TyClDecl GhcPs
d | d :: TyClDecl GhcPs
d@(Hs.DataDecl XDataDecl GhcPs
_ Located (IdP GhcPs)
_ LHsQTyVars GhcPs
_ LexicalFixity
_ HsDataDefn GhcPs
_) <- [TyClDecl GhcPs]
tyClDecls ]
dataDefns :: [HsDataDefn GhcPs]
dataDefns = (TyClDecl GhcPs -> HsDataDefn GhcPs)
-> [TyClDecl GhcPs] -> [HsDataDefn GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map TyClDecl GhcPs -> HsDataDefn GhcPs
forall pass. TyClDecl pass -> HsDataDefn pass
Hs.tcdDataDefn [TyClDecl GhcPs]
dataDecls
d :: ConDecl GhcPs
d@Hs.ConDeclH98 {} <- (HsDataDefn GhcPs -> [ConDecl GhcPs])
-> [HsDataDefn GhcPs] -> [ConDecl GhcPs]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap HsDataDefn GhcPs -> [ConDecl GhcPs]
getConDecls [HsDataDefn GhcPs]
dataDefns
case ConDecl GhcPs -> HsConDeclDetails GhcPs
forall pass. ConDecl pass -> HsConDeclDetails pass
Hs.con_args ConDecl GhcPs
d of
Hs.RecCon Located Record
rec -> [Located Record -> SrcSpanLess (Located Record)
forall a. HasSrcSpan a => a -> SrcSpanLess a
S.unLoc Located Record
rec]
HsConDeclDetails GhcPs
_ -> []
where
getConDecls :: Hs.HsDataDefn Hs.GhcPs -> [Hs.ConDecl Hs.GhcPs]
getConDecls :: HsDataDefn GhcPs -> [ConDecl GhcPs]
getConDecls d :: HsDataDefn GhcPs
d@Hs.HsDataDefn {} = (LConDecl GhcPs -> ConDecl GhcPs)
-> [LConDecl GhcPs] -> [ConDecl GhcPs]
forall a b. (a -> b) -> [a] -> [b]
map LConDecl GhcPs -> ConDecl GhcPs
forall a. HasSrcSpan a => a -> SrcSpanLess a
S.unLoc ([LConDecl GhcPs] -> [ConDecl GhcPs])
-> [LConDecl GhcPs] -> [ConDecl GhcPs]
forall a b. (a -> b) -> a -> b
$ HsDataDefn GhcPs -> [LConDecl GhcPs]
forall pass. HsDataDefn pass -> [LConDecl pass]
Hs.dd_cons HsDataDefn GhcPs
d
getConDecls (Hs.XHsDataDefn XXHsDataDefn GhcPs
x) = NoExtCon -> [ConDecl GhcPs]
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXHsDataDefn GhcPs
x
recordToAlignable :: Config -> Record -> [[Alignable S.RealSrcSpan]]
recordToAlignable :: Config -> Record -> [[Alignable RealSrcSpan]]
recordToAlignable Config
conf = Align -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
groupAlign (Config -> Align
cRecords Config
conf) ([Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]])
-> (Record -> [Alignable RealSrcSpan])
-> Record
-> [[Alignable RealSrcSpan]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Alignable RealSrcSpan]
-> Maybe [Alignable RealSrcSpan] -> [Alignable RealSrcSpan]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Alignable RealSrcSpan] -> [Alignable RealSrcSpan])
-> (Record -> Maybe [Alignable RealSrcSpan])
-> Record
-> [Alignable RealSrcSpan]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (ConDeclField GhcPs) -> Maybe (Alignable RealSrcSpan))
-> Record -> Maybe [Alignable RealSrcSpan]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Located (ConDeclField GhcPs) -> Maybe (Alignable RealSrcSpan)
fieldDeclToAlignable
fieldDeclToAlignable
:: S.Located (Hs.ConDeclField Hs.GhcPs) -> Maybe (Alignable S.RealSrcSpan)
fieldDeclToAlignable :: Located (ConDeclField GhcPs) -> Maybe (Alignable RealSrcSpan)
fieldDeclToAlignable (S.L SrcSpan
_ (Hs.XConDeclField XXConDeclField GhcPs
x)) = NoExtCon -> Maybe (Alignable RealSrcSpan)
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXConDeclField GhcPs
x
fieldDeclToAlignable (S.L SrcSpan
matchLoc (Hs.ConDeclField XConDeclField GhcPs
_ [LFieldOcc GhcPs]
names LBangType GhcPs
ty Maybe LHsDocString
_)) = do
RealSrcSpan
matchPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
matchLoc
RealSrcSpan
leftPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LFieldOcc GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc (LFieldOcc GhcPs -> SrcSpan) -> LFieldOcc GhcPs -> SrcSpan
forall a b. (a -> b) -> a -> b
$ [LFieldOcc GhcPs] -> LFieldOcc GhcPs
forall a. [a] -> a
last [LFieldOcc GhcPs]
names
RealSrcSpan
tyPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LBangType GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc LBangType GhcPs
ty
Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan)
forall a. a -> Maybe a
Just (Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan))
-> Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan)
forall a b. (a -> b) -> a -> b
$ Alignable :: forall a. a -> a -> a -> Int -> Alignable a
Alignable
{ aContainer :: RealSrcSpan
aContainer = RealSrcSpan
matchPos
, aLeft :: RealSrcSpan
aLeft = RealSrcSpan
leftPos
, aRight :: RealSrcSpan
aRight = RealSrcSpan
tyPos
, aRightLead :: Int
aRightLead = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
":: "
}
matchGroupToAlignable
:: Config
-> Hs.MatchGroup Hs.GhcPs (Hs.LHsExpr Hs.GhcPs)
-> [[Alignable S.RealSrcSpan]]
matchGroupToAlignable :: Config
-> MatchGroup GhcPs (LHsExpr GhcPs) -> [[Alignable RealSrcSpan]]
matchGroupToAlignable Config
_conf (Hs.XMatchGroup XXMatchGroup GhcPs (LHsExpr GhcPs)
x) = NoExtCon -> [[Alignable RealSrcSpan]]
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXMatchGroup GhcPs (LHsExpr GhcPs)
x
matchGroupToAlignable Config
conf (Hs.MG XMG GhcPs (LHsExpr GhcPs)
_ Located [LMatch GhcPs (LHsExpr GhcPs)]
alts Origin
_) = [[Alignable RealSrcSpan]]
cases' [[Alignable RealSrcSpan]]
-> [[Alignable RealSrcSpan]] -> [[Alignable RealSrcSpan]]
forall a. [a] -> [a] -> [a]
++ [[Alignable RealSrcSpan]]
patterns'
where
([Alignable RealSrcSpan]
cases, [Alignable RealSrcSpan]
patterns) = [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> ([Alignable RealSrcSpan], [Alignable RealSrcSpan])
forall a b. [Either a b] -> ([a], [b])
partitionEithers ([Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> ([Alignable RealSrcSpan], [Alignable RealSrcSpan]))
-> (Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)])
-> Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> ([Alignable RealSrcSpan], [Alignable RealSrcSpan])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> ([Alignable RealSrcSpan], [Alignable RealSrcSpan]))
-> Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
-> ([Alignable RealSrcSpan], [Alignable RealSrcSpan])
forall a b. (a -> b) -> a -> b
$ (LMatch GhcPs (LHsExpr GhcPs)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)))
-> [LMatch GhcPs (LHsExpr GhcPs)]
-> Maybe [Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LMatch GhcPs (LHsExpr GhcPs)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
matchToAlignable (Located [LMatch GhcPs (LHsExpr GhcPs)]
-> SrcSpanLess (Located [LMatch GhcPs (LHsExpr GhcPs)])
forall a. HasSrcSpan a => a -> SrcSpanLess a
S.unLoc Located [LMatch GhcPs (LHsExpr GhcPs)]
alts)
cases' :: [[Alignable RealSrcSpan]]
cases' = Align -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
groupAlign (Config -> Align
cCases Config
conf) [Alignable RealSrcSpan]
cases
patterns' :: [[Alignable RealSrcSpan]]
patterns' = Align -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
groupAlign (Config -> Align
cTopLevelPatterns Config
conf) [Alignable RealSrcSpan]
patterns
matchToAlignable
:: S.Located (Hs.Match Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
-> Maybe (Either (Alignable S.RealSrcSpan) (Alignable S.RealSrcSpan))
matchToAlignable :: LMatch GhcPs (LHsExpr GhcPs)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
matchToAlignable (S.L SrcSpan
matchLoc m :: Match GhcPs (LHsExpr GhcPs)
m@(Hs.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
Hs.CaseAlt pats :: [LPat GhcPs]
pats@(LPat GhcPs
_ : [LPat GhcPs]
_) GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = do
let patsLocs :: [SrcSpan]
patsLocs = (Located (Pat GhcPs) -> SrcSpan)
-> [Located (Pat GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc [LPat GhcPs]
[Located (Pat GhcPs)]
pats
pat :: SrcSpan
pat = [SrcSpan] -> SrcSpan
forall a. [a] -> a
last [SrcSpan]
patsLocs
guards :: [GuardLStmt GhcPs]
guards = Match GhcPs (LHsExpr GhcPs) -> [GuardLStmt GhcPs]
getGuards Match GhcPs (LHsExpr GhcPs)
m
guardsLocs :: [SrcSpan]
guardsLocs = (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc [GuardLStmt GhcPs]
guards
left :: SrcSpan
left = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' SrcSpan -> SrcSpan -> SrcSpan
S.combineSrcSpans SrcSpan
pat [SrcSpan]
guardsLocs
LHsExpr GhcPs
body <- GRHSs GhcPs (LHsExpr GhcPs) -> Maybe (LHsExpr GhcPs)
forall a. GRHSs GhcPs a -> Maybe a
rhsBody GRHSs GhcPs (LHsExpr GhcPs)
grhss
RealSrcSpan
matchPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
matchLoc
RealSrcSpan
leftPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
left
RealSrcSpan
rightPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan (SrcSpan -> Maybe RealSrcSpan) -> SrcSpan -> Maybe RealSrcSpan
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc LHsExpr GhcPs
body
Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a. a -> Maybe a
Just (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)))
-> (Alignable RealSrcSpan
-> Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
-> Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignable RealSrcSpan
-> Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
forall a b. a -> Either a b
Left (Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)))
-> Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a b. (a -> b) -> a -> b
$ Alignable :: forall a. a -> a -> a -> Int -> Alignable a
Alignable
{ aContainer :: RealSrcSpan
aContainer = RealSrcSpan
matchPos
, aLeft :: RealSrcSpan
aLeft = RealSrcSpan
leftPos
, aRight :: RealSrcSpan
aRight = RealSrcSpan
rightPos
, aRightLead :: Int
aRightLead = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"-> "
}
matchToAlignable (S.L SrcSpan
matchLoc (Hs.Match XCMatch GhcPs (LHsExpr GhcPs)
_ (Hs.FunRhs Located (NameOrRdrName (IdP GhcPs))
name LexicalFixity
_ SrcStrictness
_) pats :: [LPat GhcPs]
pats@(LPat GhcPs
_ : [LPat GhcPs]
_) GRHSs GhcPs (LHsExpr GhcPs)
grhss)) = do
LHsExpr GhcPs
body <- GRHSs GhcPs (LHsExpr GhcPs) -> Maybe (LHsExpr GhcPs)
forall a. GRHSs GhcPs a -> Maybe a
unguardedRhsBody GRHSs GhcPs (LHsExpr GhcPs)
grhss
let patsLocs :: [SrcSpan]
patsLocs = (Located (Pat GhcPs) -> SrcSpan)
-> [Located (Pat GhcPs)] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map Located (Pat GhcPs) -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc [LPat GhcPs]
[Located (Pat GhcPs)]
pats
nameLoc :: SrcSpan
nameLoc = Located RdrName -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc Located (NameOrRdrName (IdP GhcPs))
Located RdrName
name
left :: SrcSpan
left = [SrcSpan] -> SrcSpan
forall a. [a] -> a
last (SrcSpan
nameLoc SrcSpan -> [SrcSpan] -> [SrcSpan]
forall a. a -> [a] -> [a]
: [SrcSpan]
patsLocs)
bodyLoc :: SrcSpan
bodyLoc = LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc LHsExpr GhcPs
body
RealSrcSpan
matchPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
matchLoc
RealSrcSpan
leftPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
left
RealSrcSpan
bodyPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
bodyLoc
Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a. a -> Maybe a
Just (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)))
-> (Alignable RealSrcSpan
-> Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
-> Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alignable RealSrcSpan
-> Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)
forall a b. b -> Either a b
Right (Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan)))
-> Alignable RealSrcSpan
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a b. (a -> b) -> a -> b
$ Alignable :: forall a. a -> a -> a -> Int -> Alignable a
Alignable
{ aContainer :: RealSrcSpan
aContainer = RealSrcSpan
matchPos
, aLeft :: RealSrcSpan
aLeft = RealSrcSpan
leftPos
, aRight :: RealSrcSpan
aRight = RealSrcSpan
bodyPos
, aRightLead :: Int
aRightLead = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"= "
}
matchToAlignable (S.L SrcSpan
_ (Hs.XMatch XXMatch GhcPs (LHsExpr GhcPs)
x)) = NoExtCon
-> Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXMatch GhcPs (LHsExpr GhcPs)
x
matchToAlignable (S.L SrcSpan
_ (Hs.Match XCMatch GhcPs (LHsExpr GhcPs)
_ HsMatchContext (NameOrRdrName (IdP GhcPs))
_ [LPat GhcPs]
_ GRHSs GhcPs (LHsExpr GhcPs)
_)) = Maybe (Either (Alignable RealSrcSpan) (Alignable RealSrcSpan))
forall a. Maybe a
Nothing
multiWayIfToAlignable
:: Config
-> Hs.LHsExpr Hs.GhcPs
-> [[Alignable S.RealSrcSpan]]
multiWayIfToAlignable :: Config -> LHsExpr GhcPs -> [[Alignable RealSrcSpan]]
multiWayIfToAlignable Config
conf (S.L SrcSpan
_ (Hs.HsMultiIf XMultiIf GhcPs
_ [LGRHS GhcPs (LHsExpr GhcPs)]
grhss)) =
Align -> [Alignable RealSrcSpan] -> [[Alignable RealSrcSpan]]
groupAlign (Config -> Align
cMultiWayIf Config
conf) [Alignable RealSrcSpan]
as
where
as :: [Alignable RealSrcSpan]
as = [Alignable RealSrcSpan]
-> Maybe [Alignable RealSrcSpan] -> [Alignable RealSrcSpan]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Alignable RealSrcSpan] -> [Alignable RealSrcSpan])
-> Maybe [Alignable RealSrcSpan] -> [Alignable RealSrcSpan]
forall a b. (a -> b) -> a -> b
$ (LGRHS GhcPs (LHsExpr GhcPs) -> Maybe (Alignable RealSrcSpan))
-> [LGRHS GhcPs (LHsExpr GhcPs)] -> Maybe [Alignable RealSrcSpan]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse LGRHS GhcPs (LHsExpr GhcPs) -> Maybe (Alignable RealSrcSpan)
grhsToAlignable [LGRHS GhcPs (LHsExpr GhcPs)]
grhss
multiWayIfToAlignable Config
_conf LHsExpr GhcPs
_ = []
grhsToAlignable
:: S.Located (Hs.GRHS Hs.GhcPs (Hs.LHsExpr Hs.GhcPs))
-> Maybe (Alignable S.RealSrcSpan)
grhsToAlignable :: LGRHS GhcPs (LHsExpr GhcPs) -> Maybe (Alignable RealSrcSpan)
grhsToAlignable (S.L SrcSpan
grhsloc (Hs.GRHS XCGRHS GhcPs (LHsExpr GhcPs)
_ guards :: [GuardLStmt GhcPs]
guards@(GuardLStmt GhcPs
_ : [GuardLStmt GhcPs]
_) LHsExpr GhcPs
body)) = do
let guardsLocs :: [SrcSpan]
guardsLocs = (GuardLStmt GhcPs -> SrcSpan) -> [GuardLStmt GhcPs] -> [SrcSpan]
forall a b. (a -> b) -> [a] -> [b]
map GuardLStmt GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc [GuardLStmt GhcPs]
guards
bodyLoc :: SrcSpan
bodyLoc = LHsExpr GhcPs -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
S.getLoc LHsExpr GhcPs
body
left :: SrcSpan
left = (SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
forall a. (a -> a -> a) -> [a] -> a
foldl1' SrcSpan -> SrcSpan -> SrcSpan
S.combineSrcSpans [SrcSpan]
guardsLocs
RealSrcSpan
matchPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
grhsloc
RealSrcSpan
leftPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
left
RealSrcSpan
bodyPos <- SrcSpan -> Maybe RealSrcSpan
toRealSrcSpan SrcSpan
bodyLoc
Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan)
forall a. a -> Maybe a
Just (Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan))
-> Alignable RealSrcSpan -> Maybe (Alignable RealSrcSpan)
forall a b. (a -> b) -> a -> b
$ Alignable :: forall a. a -> a -> a -> Int -> Alignable a
Alignable
{ aContainer :: RealSrcSpan
aContainer = RealSrcSpan
matchPos
, aLeft :: RealSrcSpan
aLeft = RealSrcSpan
leftPos
, aRight :: RealSrcSpan
aRight = RealSrcSpan
bodyPos
, aRightLead :: Int
aRightLead = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
"-> "
}
grhsToAlignable (S.L SrcSpan
_ (Hs.XGRHS XXGRHS GhcPs (LHsExpr GhcPs)
x)) = NoExtCon -> Maybe (Alignable RealSrcSpan)
forall a. NoExtCon -> a
Hs.noExtCon NoExtCon
XXGRHS GhcPs (LHsExpr GhcPs)
x
grhsToAlignable (S.L SrcSpan
_ GRHS GhcPs (LHsExpr GhcPs)
_) = Maybe (Alignable RealSrcSpan)
forall a. Maybe a
Nothing
step :: Maybe Int -> Config -> Step
step :: Maybe Int -> Config -> Step
step Maybe Int
maxColumns Config
config = String -> (Lines -> Module -> Lines) -> Step
makeStep String
"Cases" ((Lines -> Module -> Lines) -> Step)
-> (Lines -> Module -> Lines) -> Step
forall a b. (a -> b) -> a -> b
$ \Lines
ls Module
module' ->
let changes
:: (S.Located (Hs.HsModule Hs.GhcPs) -> [a])
-> (a -> [[Alignable S.RealSrcSpan]])
-> [Change String]
changes :: (Located (HsModule GhcPs) -> [a])
-> (a -> [[Alignable RealSrcSpan]]) -> [Change String]
changes Located (HsModule GhcPs) -> [a]
search a -> [[Alignable RealSrcSpan]]
toAlign =
(([[Alignable RealSrcSpan]] -> [Change String])
-> [[[Alignable RealSrcSpan]]] -> [Change String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([[Alignable RealSrcSpan]] -> [Change String])
-> [[[Alignable RealSrcSpan]]] -> [Change String])
-> (([Alignable RealSrcSpan] -> [Change String])
-> [[Alignable RealSrcSpan]] -> [Change String])
-> ([Alignable RealSrcSpan] -> [Change String])
-> [[[Alignable RealSrcSpan]]]
-> [Change String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Alignable RealSrcSpan] -> [Change String])
-> [[Alignable RealSrcSpan]] -> [Change String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap) (Maybe Int -> [Alignable RealSrcSpan] -> [Change String]
align Maybe Int
maxColumns) ([[[Alignable RealSrcSpan]]] -> [Change String])
-> ([a] -> [[[Alignable RealSrcSpan]]]) -> [a] -> [Change String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [[Alignable RealSrcSpan]])
-> [a] -> [[[Alignable RealSrcSpan]]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [[Alignable RealSrcSpan]]
toAlign ([a] -> [Change String]) -> [a] -> [Change String]
forall a b. (a -> b) -> a -> b
$ Located (HsModule GhcPs) -> [a]
search (Module -> Located (HsModule GhcPs)
parsedModule Module
module')
configured :: [Change String]
configured :: [Change String]
configured = [[Change String]] -> [Change String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Change String]] -> [Change String])
-> [[Change String]] -> [Change String]
forall a b. (a -> b) -> a -> b
$
[(Located (HsModule GhcPs) -> [Record])
-> (Record -> [[Alignable RealSrcSpan]]) -> [Change String]
forall a.
(Located (HsModule GhcPs) -> [a])
-> (a -> [[Alignable RealSrcSpan]]) -> [Change String]
changes Located (HsModule GhcPs) -> [Record]
records (Config -> Record -> [[Alignable RealSrcSpan]]
recordToAlignable Config
config)] [[Change String]] -> [[Change String]] -> [[Change String]]
forall a. [a] -> [a] -> [a]
++
[(Located (HsModule GhcPs) -> [MatchGroup GhcPs (LHsExpr GhcPs)])
-> (MatchGroup GhcPs (LHsExpr GhcPs) -> [[Alignable RealSrcSpan]])
-> [Change String]
forall a.
(Located (HsModule GhcPs) -> [a])
-> (a -> [[Alignable RealSrcSpan]]) -> [Change String]
changes Located (HsModule GhcPs) -> [MatchGroup GhcPs (LHsExpr GhcPs)]
forall a b. (Data a, Data b) => a -> [b]
everything (Config
-> MatchGroup GhcPs (LHsExpr GhcPs) -> [[Alignable RealSrcSpan]]
matchGroupToAlignable Config
config)] [[Change String]] -> [[Change String]] -> [[Change String]]
forall a. [a] -> [a] -> [a]
++
[(Located (HsModule GhcPs) -> [LHsExpr GhcPs])
-> (LHsExpr GhcPs -> [[Alignable RealSrcSpan]]) -> [Change String]
forall a.
(Located (HsModule GhcPs) -> [a])
-> (a -> [[Alignable RealSrcSpan]]) -> [Change String]
changes Located (HsModule GhcPs) -> [LHsExpr GhcPs]
forall a b. (Data a, Data b) => a -> [b]
everything (Config -> LHsExpr GhcPs -> [[Alignable RealSrcSpan]]
multiWayIfToAlignable Config
config)] in
[Change String] -> Lines -> Lines
forall a. [Change a] -> [a] -> [a]
applyChanges [Change String]
configured Lines
ls