{-# 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
(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 String
"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 [String]
input = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break String -> Bool
startsWithSpace [String]
input of
      ([], []) -> []
      ([String]
xs, [String]
ys) -> case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
startsWithSpace [String]
ys of
        ([String]
fields, [String]
zs) -> case [String] -> [String]
forall a. [a] -> [a]
reverse [String]
xs of
          String
name : [String]
_ -> (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, [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 = 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 [String]
input = case [Int] -> [Int]
forall a. Ord 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
  [Int
n] -> Alignment -> Maybe Alignment
forall a. a -> Maybe a
Just (Int -> Alignment
Alignment Int
n)
  [Int]
_ -> Maybe Alignment
forall a. Maybe a
Nothing
  where

    indentation :: (String, String) -> Maybe Int
    indentation :: (String, String) -> Maybe Int
indentation (String
name, String
value) = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isSpace String
value of
      (String
_, String
"") -> Maybe Int
forall a. Maybe a
Nothing
      (String
xs, String
_) -> (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 String
field = case (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isNameChar String
field of
  (String
xs, Char
':':String
ys) -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
xs, String
ys)
  (String, String)
_ -> 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 = [Char
'a'..Char
'z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
'A'..Char
'Z'] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-"

sniffIndentation :: [String] -> Maybe Int
sniffIndentation :: [String] -> Maybe Int
sniffIndentation [String]
input = String -> Maybe Int
sniffFrom String
"library" Maybe Int -> Maybe Int -> Maybe Int
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 ([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
      String
_ : String
x : [String]
_ -> 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
      [String]
_ -> 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 [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
"," (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 [String]
input = Int -> Alignment -> CommaStyle -> RenderSettings
RenderSettings Int
indentation Alignment
fieldAlignment CommaStyle
commaStyle
  where
    indentation :: Int
indentation = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
def (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
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 = CommaStyle -> Maybe CommaStyle -> CommaStyle
forall a. a -> Maybe a -> a
fromMaybe (RenderSettings -> CommaStyle
renderSettingsCommaStyle RenderSettings
defaultRenderSettings) ([String] -> Maybe CommaStyle
sniffCommaStyle [String]
input)