    {-# LANGUAGE LambdaCase #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE ViewPatterns #-}

    -- | Random utilities used by the code.
    module Ormolu.Utils
      ( RelativePos (..),
        attachRelativePos,
        combineSrcSpans',
        notImplemented,
        showOutputable,
        splitDocString,
        typeArgToType,
        unSrcSpan,
        incSpanLine,
        separatedByBlank,
        separatedByBlankNE,
        onTheSameLine,
        removeIndentation,
      )
    where

    import Data.Char (isSpace)
    import Data.List (dropWhileEnd)
    import Data.List.NonEmpty (NonEmpty (..))
    import qualified Data.List.NonEmpty as NE
    import Data.Maybe (fromMaybe)
    import Data.Text (Text)
    import qualified Data.Text as T
    import GHC
    import GHC.DynFlags (baseDynFlags)
    import qualified Outputable as GHC

    -- | Relative positions in a list.
    data RelativePos
      = SinglePos
      | FirstPos
      | MiddlePos
      | LastPos
      deriving (RelativePos -> RelativePos -> Bool
    (RelativePos -> RelativePos -> Bool)
    -> (RelativePos -> RelativePos -> Bool) -> Eq RelativePos
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: RelativePos -> RelativePos -> Bool
    $c/= :: RelativePos -> RelativePos -> Bool
    == :: RelativePos -> RelativePos -> Bool
    $c== :: RelativePos -> RelativePos -> Bool
    Eq, Int -> RelativePos -> ShowS
    [RelativePos] -> ShowS
    RelativePos -> String
    (Int -> RelativePos -> ShowS)
    -> (RelativePos -> String)
    -> ([RelativePos] -> ShowS)
    -> Show RelativePos
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [RelativePos] -> ShowS
    $cshowList :: [RelativePos] -> ShowS
    show :: RelativePos -> String
    $cshow :: RelativePos -> String
    showsPrec :: Int -> RelativePos -> ShowS
    $cshowsPrec :: Int -> RelativePos -> ShowS
    Show)

    -- | Attach 'RelativePos'es to elements of a given list.
    attachRelativePos :: [a] -> [(RelativePos, a)]
    attachRelativePos :: [a] -> [(RelativePos, a)]
    attachRelativePos = \case
      [] -> []
      [x :: a
    x] -> [(RelativePos
    SinglePos, a
    x)]
      (x :: a
    x : xs :: [a]
    xs) -> (RelativePos
    FirstPos, a
    x) (RelativePos, a) -> [(RelativePos, a)] -> [(RelativePos, a)]
    forall a. a -> [a] -> [a]
    : [a] -> [(RelativePos, a)]
    forall b. [b] -> [(RelativePos, b)]
    markLast [a]
    xs
      where
        markLast :: [b] -> [(RelativePos, b)]
    markLast [] = []
        markLast [x :: b
    x] = [(RelativePos
    LastPos, b
    x)]
        markLast (x :: b
    x : xs :: [b]
    xs) = (RelativePos
    MiddlePos, b
    x) (RelativePos, b) -> [(RelativePos, b)] -> [(RelativePos, b)]
    forall a. a -> [a] -> [a]
    : [b] -> [(RelativePos, b)]
    markLast [b]
    xs

    -- | Combine all source spans from the given list.
    combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan
    combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan
    combineSrcSpans' (x :: SrcSpan
    x :| xs :: [SrcSpan]
    xs) = (SrcSpan -> SrcSpan -> SrcSpan) -> SrcSpan -> [SrcSpan] -> SrcSpan
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans SrcSpan
    x [SrcSpan]
    xs

    -- | Placeholder for things that are not yet implemented.
    notImplemented :: String -> a
    notImplemented :: String -> a
    notImplemented msg :: String
    msg = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ "not implemented yet: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    -- | Pretty-print an 'GHC.Outputable' thing.
    showOutputable :: GHC.Outputable o => o -> String
    showOutputable :: o -> String
    showOutputable = DynFlags -> SDoc -> String
    GHC.showSDoc DynFlags
    baseDynFlags (SDoc -> String) -> (o -> SDoc) -> o -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . o -> SDoc
    forall a. Outputable a => a -> SDoc
    GHC.ppr

    -- | Split and normalize a doc string. The result is a list of lines that
    -- make up the comment.
    splitDocString :: HsDocString -> [Text]
    splitDocString :: HsDocString -> [Text]
    splitDocString docStr :: HsDocString
    docStr =
      case [Text]
    r of
        [] -> [""]
        _ -> [Text]
    r
      where
        r :: [Text]
    r =
          (Text -> Text) -> [Text] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Text -> Text
    escapeLeadingDollar
            ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Text] -> [Text]
    dropPaddingSpace
            ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhileEnd Text -> Bool
    T.null
            ([Text] -> [Text]) -> (String -> [Text]) -> String -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Text) -> [String] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Text -> Text
    T.stripEnd (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack)
            ([String] -> [Text]) -> (String -> [String]) -> String -> [Text]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
            (String -> [Text]) -> String -> [Text]
    forall a b. (a -> b) -> a -> b
    $ HsDocString -> String
    unpackHDS HsDocString
    docStr
        -- We cannot have the first character to be a dollar because in that
        -- case it'll be a parse error (apparently collides with named docs
        -- syntax @-- $name@ somehow).
        escapeLeadingDollar :: Text -> Text
    escapeLeadingDollar txt :: Text
    txt =
          case Text -> Maybe (Char, Text)
    T.uncons Text
    txt of
            Just ('$', _) -> Char -> Text -> Text
    T.cons '\\' Text
    txt
            _ -> Text
    txt
        dropPaddingSpace :: [Text] -> [Text]
    dropPaddingSpace xs :: [Text]
    xs =
          case (Text -> Bool) -> [Text] -> [Text]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Text -> Bool
    T.null [Text]
    xs of
            [] -> []
            (x :: Text
    x : _) ->
              let leadingSpace :: Text -> Bool
    leadingSpace txt :: Text
    txt = case Text -> Maybe (Char, Text)
    T.uncons Text
    txt of
                    Just (' ', _) -> Bool
    True
                    _ -> Bool
    False
                  dropSpace :: Text -> Text
    dropSpace txt :: Text
    txt =
                    if Text -> Bool
    leadingSpace Text
    txt
                      then Int -> Text -> Text
    T.drop 1 Text
    txt
                      else Text
    txt
               in if Text -> Bool
    leadingSpace Text
    x
                    then Text -> Text
    dropSpace (Text -> Text) -> [Text] -> [Text]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Text]
    xs
                    else [Text]
    xs

    -- | Get 'LHsType' out of 'LHsTypeArg'.
    typeArgToType :: LHsTypeArg p -> LHsType p
    typeArgToType :: LHsTypeArg p -> LHsType p
    typeArgToType = \case
      HsValArg tm :: LHsType p
    tm -> LHsType p
    tm
      HsTypeArg _ ty :: LHsType p
    ty -> LHsType p
    ty
      HsArgPar _ -> String -> LHsType p
    forall a. String -> a
    notImplemented "HsArgPar"

    -- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”.
    unSrcSpan :: SrcSpan -> Maybe RealSrcSpan
    unSrcSpan :: SrcSpan -> Maybe RealSrcSpan
    unSrcSpan = \case
      RealSrcSpan r :: RealSrcSpan
    r -> RealSrcSpan -> Maybe RealSrcSpan
    forall a. a -> Maybe a
    Just RealSrcSpan
    r
      UnhelpfulSpan _ -> Maybe RealSrcSpan
    forall a. Maybe a
    Nothing

    -- | Increment line number in a 'SrcSpan'.
    incSpanLine :: Int -> SrcSpan -> SrcSpan
    incSpanLine :: Int -> SrcSpan -> SrcSpan
    incSpanLine i :: Int
    i = \case
      RealSrcSpan s :: RealSrcSpan
    s ->
        let start :: RealSrcLoc
    start = RealSrcSpan -> RealSrcLoc
    realSrcSpanStart RealSrcSpan
    s
            end :: RealSrcLoc
    end = RealSrcSpan -> RealSrcLoc
    realSrcSpanEnd RealSrcSpan
    s
            incLine :: RealSrcLoc -> RealSrcLoc
    incLine x :: RealSrcLoc
    x =
              let file :: FastString
    file = RealSrcLoc -> FastString
    srcLocFile RealSrcLoc
    x
                  line :: Int
    line = RealSrcLoc -> Int
    srcLocLine RealSrcLoc
    x
                  col :: Int
    col = RealSrcLoc -> Int
    srcLocCol RealSrcLoc
    x
               in FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc FastString
    file (Int
    line Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    i) Int
    col
         in RealSrcSpan -> SrcSpan
    RealSrcSpan (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
    mkRealSrcSpan (RealSrcLoc -> RealSrcLoc
    incLine RealSrcLoc
    start) (RealSrcLoc -> RealSrcLoc
    incLine RealSrcLoc
    end))
      UnhelpfulSpan x :: FastString
    x -> FastString -> SrcSpan
    UnhelpfulSpan FastString
    x

    -- | Do two declarations have a blank between them?
    separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool
    separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool
    separatedByBlank loc :: a -> SrcSpan
    loc a :: a
    a b :: a
    b =
      Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ do
        Int
    endA <- RealSrcSpan -> Int
    srcSpanEndLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SrcSpan -> Maybe RealSrcSpan
    unSrcSpan (a -> SrcSpan
    loc a
    a)
        Int
    startB <- RealSrcSpan -> Int
    srcSpanStartLine (RealSrcSpan -> Int) -> Maybe RealSrcSpan -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SrcSpan -> Maybe RealSrcSpan
    unSrcSpan (a -> SrcSpan
    loc a
    b)
        Bool -> Maybe Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Int
    startB Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    endA Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 2)

    -- | Do two declaration groups have a blank between them?
    separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool
    separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool
    separatedByBlankNE loc :: a -> SrcSpan
    loc a :: NonEmpty a
    a b :: NonEmpty a
    b = (a -> SrcSpan) -> a -> a -> Bool
    forall a. (a -> SrcSpan) -> a -> a -> Bool
    separatedByBlank a -> SrcSpan
    loc (NonEmpty a -> a
    forall a. NonEmpty a -> a
    NE.last NonEmpty a
    a) (NonEmpty a -> a
    forall a. NonEmpty a -> a
    NE.head NonEmpty a
    b)

    -- | Return 'True' if one span ends on the same line the second one starts.
    onTheSameLine :: SrcSpan -> SrcSpan -> Bool
    onTheSameLine :: SrcSpan -> SrcSpan -> Bool
    onTheSameLine a :: SrcSpan
    a b :: SrcSpan
    b =
      SrcSpan -> Bool
    isOneLineSpan (SrcLoc -> SrcLoc -> SrcSpan
    mkSrcSpan (SrcSpan -> SrcLoc
    srcSpanEnd SrcSpan
    a) (SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    b))

    -- | Remove indentation from a given 'String'. Return the input with
    -- indentation removed and the detected indentation level.
    removeIndentation :: String -> (String, Int)
    removeIndentation :: String -> (String, Int)
    removeIndentation (String -> [String]
    lines -> [String]
    xs) = ([String] -> String
    unlines (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    n ShowS -> [String] -> [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    xs), Int
    n)
      where
        n :: Int
    n = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum (String -> Int
    getIndent (String -> Int) -> [String] -> [Int]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [String]
    xs)
        getIndent :: String -> Int
    getIndent y :: String
    y =
          if (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    y
            then 0
            else String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isSpace String
    y)