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

import           Imports

import           Data.Char
import           Data.Maybe

import           Hpack.Render.Dsl
import           Hpack.Util

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
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
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 {
  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 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"cabal-version:") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ShowS
stripEnd

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

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

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

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

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

data Indentation = Indentation {
  Indentation -> Int
indentationFieldNameLength :: Int
, Indentation -> Int
indentationPadding :: Int
}

indentationTotal :: Indentation -> Int
indentationTotal :: Indentation -> Int
indentationTotal (Indentation Int
fieldName Int
padding) = Int
fieldName forall a. Num a => a -> a -> a
+ Int
padding

sniffAlignment :: [String] -> Maybe Alignment
sniffAlignment :: [String] -> Maybe Alignment
sniffAlignment [String]
input = case [Indentation]
indentations of
  [] -> forall a. Maybe a
Nothing
  [Indentation]
_ | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Indentation -> Int
indentationPadding forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (forall a. Eq a => a -> a -> Bool
== Int
1)) [Indentation]
indentations -> forall a. a -> Maybe a
Just Alignment
0
  [Indentation]
_ -> case forall a. Ord a => [a] -> [a]
nub (forall a b. (a -> b) -> [a] -> [b]
map Indentation -> Int
indentationTotal [Indentation]
indentations) of
    [Int
n] -> forall a. a -> Maybe a
Just (Int -> Alignment
Alignment Int
n)
    [Int]
_ -> forall a. Maybe a
Nothing
  where
    indentations :: [Indentation]
    indentations :: [Indentation]
indentations = forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe (String, String)
splitField forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> (String, String) -> Maybe Indentation
indentation) forall a b. (a -> b) -> a -> b
$ [String]
input

    indentation :: (String, String) -> Maybe Indentation
    indentation :: (String, String) -> Maybe Indentation
indentation (String
name, String
value) = case forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
value of
      (String
_, String
"") -> forall a. Maybe a
Nothing
      (String
padding, String
_) -> forall a. a -> Maybe a
Just Indentation {
        indentationFieldNameLength :: Int
indentationFieldNameLength = forall a. Enum a => a -> a
succ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name
      , indentationPadding :: Int
indentationPadding = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
padding
      }

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

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

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

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

sniffRenderSettings :: [String] -> RenderSettings
sniffRenderSettings :: [String] -> RenderSettings
sniffRenderSettings [String]
input = Int -> Alignment -> CommaStyle -> RenderSettings
RenderSettings Int
indentation Alignment
fieldAlignment CommaStyle
commaStyle
  where
    indentation :: Int
indentation = forall a. Ord a => a -> a -> a
max Int
def forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Int
def ([String] -> Maybe Int
sniffIndentation [String]
input)
      where def :: Int
def = RenderSettings -> Int
renderSettingsIndentation RenderSettings
defaultRenderSettings

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