    {-# LANGUAGE CPP #-}
    {-# LANGUAGE ViewPatterns #-}
    module Hpack.Render.Hints (
      FormattingHints (..)
    , sniffFormattingHints
    #ifdef TEST
    , extractFieldOrder
    , extractSectionsFieldOrder
    , sanitize
    , unindent
    , sniffAlignment
    , splitField
    , sniffIndentation
    , sniffCommaStyle
    #endif
    ) where

    import           Data.Char
    import           Data.Maybe
    import           Data.List
    import           Control.Applicative

    import           Hpack.Render.Dsl

    data FormattingHints = FormattingHints {
      FormattingHints -> [String]
    formattingHintsFieldOrder :: [String]
    , FormattingHints -> [(String, [String])]
    formattingHintsSectionsFieldOrder :: [(String, [String])]
    , FormattingHints -> Maybe Alignment
    formattingHintsAlignment :: Maybe Alignment
    , FormattingHints -> RenderSettings
    formattingHintsRenderSettings :: RenderSettings
    } deriving (FormattingHints -> FormattingHints -> Bool
    (FormattingHints -> FormattingHints -> Bool)
    -> (FormattingHints -> FormattingHints -> Bool)
    -> Eq FormattingHints
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: FormattingHints -> FormattingHints -> Bool
    $c/= :: FormattingHints -> FormattingHints -> Bool
    == :: FormattingHints -> FormattingHints -> Bool
    $c== :: FormattingHints -> FormattingHints -> Bool
    Eq, Int -> FormattingHints -> ShowS
    [FormattingHints] -> ShowS
    FormattingHints -> String
    (Int -> FormattingHints -> ShowS)
    -> (FormattingHints -> String)
    -> ([FormattingHints] -> ShowS)
    -> Show FormattingHints
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [FormattingHints] -> ShowS
    $cshowList :: [FormattingHints] -> ShowS
    show :: FormattingHints -> String
    $cshow :: FormattingHints -> String
    showsPrec :: Int -> FormattingHints -> ShowS
    $cshowsPrec :: Int -> FormattingHints -> ShowS
    Show)

    sniffFormattingHints :: [String] -> FormattingHints
    sniffFormattingHints :: [String] -> FormattingHints
    sniffFormattingHints ([String] -> [String]
    sanitize -> [String]
    input) = FormattingHints :: [String]
    -> [(String, [String])]
    -> Maybe Alignment
    -> RenderSettings
    -> FormattingHints
    FormattingHints {
      formattingHintsFieldOrder :: [String]
    formattingHintsFieldOrder = [String] -> [String]
    extractFieldOrder [String]
    input
    , formattingHintsSectionsFieldOrder :: [(String, [String])]
    formattingHintsSectionsFieldOrder = [String] -> [(String, [String])]
    extractSectionsFieldOrder [String]
    input
    , formattingHintsAlignment :: Maybe Alignment
    formattingHintsAlignment = [String] -> Maybe Alignment
    sniffAlignment [String]
    input
    , formattingHintsRenderSettings :: RenderSettings
    formattingHintsRenderSettings = [String] -> RenderSettings
    sniffRenderSettings [String]
    input
    }

    sanitize :: [String] -> [String]
    sanitize :: [String] -> [String]
    sanitize = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf "cabal-version:") ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ShowS
    stripEnd

    stripEnd :: String -> String
    stripEnd :: ShowS
    stripEnd = ShowS
    forall a. [a] -> [a]
    reverse ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse

    extractFieldOrder :: [String] -> [String]
    extractFieldOrder :: [String] -> [String]
    extractFieldOrder = ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst ([(String, String)] -> [String])
    -> ([String] -> [(String, String)]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (String, String)] -> [(String, String)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (String, String)] -> [(String, String)])
    -> ([String] -> [Maybe (String, String)])
    -> [String]
    -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Maybe (String, String))
    -> [String] -> [Maybe (String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Maybe (String, String)
    splitField

    extractSectionsFieldOrder :: [String] -> [(String, [String])]
    extractSectionsFieldOrder :: [String] -> [(String, [String])]
    extractSectionsFieldOrder = ((String, [String]) -> (String, [String]))
    -> [(String, [String])] -> [(String, [String])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([String] -> [String]) -> (String, [String]) -> (String, [String])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [String] -> [String]
    extractFieldOrder) ([(String, [String])] -> [(String, [String])])
    -> ([String] -> [(String, [String])])
    -> [String]
    -> [(String, [String])]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [(String, [String])]
    splitSections
      where
        splitSections :: [String] -> [(String, [String])]
    splitSections input :: [String]
    input = case (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break String -> Bool
    startsWithSpace [String]
    input of
          ([], []) -> []
          (xs :: [String]
    xs, ys :: [String]
    ys) -> case (String -> Bool) -> [String] -> ([String], [String])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span String -> Bool
    startsWithSpace [String]
    ys of
            (fields :: [String]
    fields, zs :: [String]
    zs) -> case [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    xs of
              name :: String
    name : _ -> (String
    name, [String] -> [String]
    unindent [String]
    fields) (String, [String]) -> [(String, [String])] -> [(String, [String])]
    forall a. a -> [a] -> [a]
    : [String] -> [(String, [String])]
    splitSections [String]
    zs
              _ -> [String] -> [(String, [String])]
    splitSections [String]
    zs

        startsWithSpace :: String -> Bool
        startsWithSpace :: String -> Bool
    startsWithSpace xs :: String
    xs = case String
    xs of
          y :: Char
    y : _ -> Char -> Bool
    isSpace Char
    y
          _ -> Bool
    False

    unindent :: [String] -> [String]
    unindent :: [String] -> [String]
    unindent input :: [String]
    input = ShowS -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop Int
    indentation) [String]
    input
      where
        indentation :: Int
    indentation = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    minimum ([Int] -> Int) -> [Int] -> Int
    forall a b. (a -> b) -> a -> b
    $ (String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> ShowS -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isSpace) [String]
    input

    sniffAlignment :: [String] -> Maybe Alignment
    sniffAlignment :: [String] -> Maybe Alignment
    sniffAlignment input :: [String]
    input = case [Int] -> [Int]
    forall a. Eq a => [a] -> [a]
    nub ([Int] -> [Int]) -> ([String] -> [Int]) -> [String] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe Int] -> [Int]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe Int] -> [Int])
    -> ([String] -> [Maybe Int]) -> [String] -> [Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, String) -> Maybe Int)
    -> [(String, String)] -> [Maybe Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> Maybe Int
    indentation ([(String, String)] -> [Maybe Int])
    -> ([String] -> [(String, String)]) -> [String] -> [Maybe Int]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe (String, String)] -> [(String, String)]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe (String, String)] -> [(String, String)])
    -> ([String] -> [Maybe (String, String)])
    -> [String]
    -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Maybe (String, String))
    -> [String] -> [Maybe (String, String)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Maybe (String, String)
    splitField ([String] -> [Int]) -> [String] -> [Int]
    forall a b. (a -> b) -> a -> b
    $ [String]
    input of
      [n :: Int
    n] -> Alignment -> Maybe Alignment
    forall a. a -> Maybe a
    Just (Int -> Alignment
    Alignment Int
    n)
      _ -> Maybe Alignment
    forall a. Maybe a
    Nothing
      where

        indentation :: (String, String) -> Maybe Int
        indentation :: (String, String) -> Maybe Int
    indentation (name :: String
    name, value :: String
    value) = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isSpace String
    value of
          (_, "") -> Maybe Int
    forall a. Maybe a
    Nothing
          (xs :: String
    xs, _) -> (Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> (String -> Int) -> String -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int
    forall a. Enum a => a -> a
    succ (Int -> Int) -> (String -> Int) -> String -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Maybe Int) -> String -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    xs)

    splitField :: String -> Maybe (String, String)
    splitField :: String -> Maybe (String, String)
    splitField field :: String
    field = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span Char -> Bool
    isNameChar String
    field of
      (xs :: String
    xs, ':':ys :: String
    ys) -> (String, String) -> Maybe (String, String)
    forall a. a -> Maybe a
    Just (String
    xs, String
    ys)
      _ -> Maybe (String, String)
    forall a. Maybe a
    Nothing
      where
        isNameChar :: Char -> Bool
    isNameChar = (Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    nameChars)
        nameChars :: String
    nameChars = ['a'..'z'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ['A'..'Z'] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ "-"

    sniffIndentation :: [String] -> Maybe Int
    sniffIndentation :: [String] -> Maybe Int
    sniffIndentation input :: [String]
    input = String -> Maybe Int
    sniffFrom "library" Maybe Int -> Maybe Int -> Maybe Int
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> String -> Maybe Int
    sniffFrom "executable"
      where
        sniffFrom :: String -> Maybe Int
        sniffFrom :: String -> Maybe Int
    sniffFrom section :: String
    section = case [String] -> [String]
    findSection ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    removeEmptyLines ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ [String]
    input of
          _ : x :: String
    x : _ -> Int -> Maybe Int
    forall a. a -> Maybe a
    Just (Int -> Maybe Int) -> (String -> Int) -> String -> Maybe Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Maybe Int) -> String -> Maybe Int
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isSpace String
    x
          _ -> Maybe Int
    forall a. Maybe a
    Nothing
          where
            findSection :: [String] -> [String]
    findSection = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf String
    section)

        removeEmptyLines :: [String] -> [String]
        removeEmptyLines :: [String] -> [String]
    removeEmptyLines = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((String -> Bool) -> [String] -> [String])
    -> (String -> Bool) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isSpace)

    sniffCommaStyle :: [String] -> Maybe CommaStyle
    sniffCommaStyle :: [String] -> Maybe CommaStyle
    sniffCommaStyle input :: [String]
    input
      | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any String -> Bool
    startsWithComma [String]
    input = CommaStyle -> Maybe CommaStyle
    forall a. a -> Maybe a
    Just CommaStyle
    LeadingCommas
      | (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> Bool
    startsWithComma (String -> Bool) -> ShowS -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ShowS
    forall a. [a] -> [a]
    reverse) [String]
    input = CommaStyle -> Maybe CommaStyle
    forall a. a -> Maybe a
    Just CommaStyle
    TrailingCommas
      | Bool
    otherwise = Maybe CommaStyle
    forall a. Maybe a
    Nothing
      where
        startsWithComma :: String -> Bool
    startsWithComma = String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    isPrefixOf "," (String -> Bool) -> ShowS -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace

    sniffRenderSettings :: [String] -> RenderSettings
    sniffRenderSettings :: [String] -> RenderSettings
    sniffRenderSettings input :: [String]
    input = Int -> Alignment -> CommaStyle -> RenderSettings
    RenderSettings Int
    indentation Alignment
    fieldAlignment CommaStyle
    commaStyle
      where
        indentation :: Int
    indentation = Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe (RenderSettings -> Int
    renderSettingsIndentation RenderSettings
    defaultRenderSettings) ([String] -> Maybe Int
    sniffIndentation [String]
    input)
        fieldAlignment :: Alignment
    fieldAlignment = RenderSettings -> Alignment
    renderSettingsFieldAlignment RenderSettings
    defaultRenderSettings
        commaStyle :: CommaStyle
    commaStyle = CommaStyle -> Maybe CommaStyle -> CommaStyle
    forall a. a -> Maybe a -> a
    fromMaybe (RenderSettings -> CommaStyle
    renderSettingsCommaStyle RenderSettings
    defaultRenderSettings) ([String] -> Maybe CommaStyle
    sniffCommaStyle [String]
    input)