{-|
Description : Parametrization of formatting
-}
module Language.Haskell.Formatter.Style
       (Style, lineLengthLimit, ribbonsPerLine, successiveEmptyLinesLimit,
        classIndentation, doIndentation, caseIndentation, letIndentation,
        whereIndentation, onsideIndentation, orderImportDeclarations,
        orderImportEntities, Indentation, defaultStyle, check)
       where
import qualified Data.Maybe as Maybe
import qualified Language.Haskell.Formatter.Error as Error
import qualified Language.Haskell.Formatter.Internal.Newline as Newline
import qualified Language.Haskell.Formatter.Result as Result
import qualified Language.Haskell.Formatter.Source as Source

data Style = Style{Style -> Int
lineLengthLimit :: Int, Style -> Float
ribbonsPerLine :: Float,
                   Style -> Int
successiveEmptyLinesLimit :: Int,
                   Style -> Int
classIndentation :: Indentation,
                   Style -> Int
doIndentation :: Indentation, Style -> Int
caseIndentation :: Indentation,
                   Style -> Int
letIndentation :: Indentation,
                   Style -> Int
whereIndentation :: Indentation,
                   Style -> Int
onsideIndentation :: Indentation,
                   Style -> Bool
orderImportDeclarations :: Bool, Style -> Bool
orderImportEntities :: Bool}
               deriving (Style -> Style -> Bool
(Style -> Style -> Bool) -> (Style -> Style -> Bool) -> Eq Style
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Style -> Style -> Bool
$c/= :: Style -> Style -> Bool
== :: Style -> Style -> Bool
$c== :: Style -> Style -> Bool
Eq, Eq Style
Eq Style
-> (Style -> Style -> Ordering)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Bool)
-> (Style -> Style -> Style)
-> (Style -> Style -> Style)
-> Ord Style
Style -> Style -> Bool
Style -> Style -> Ordering
Style -> Style -> Style
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Style -> Style -> Style
$cmin :: Style -> Style -> Style
max :: Style -> Style -> Style
$cmax :: Style -> Style -> Style
>= :: Style -> Style -> Bool
$c>= :: Style -> Style -> Bool
> :: Style -> Style -> Bool
$c> :: Style -> Style -> Bool
<= :: Style -> Style -> Bool
$c<= :: Style -> Style -> Bool
< :: Style -> Style -> Bool
$c< :: Style -> Style -> Bool
compare :: Style -> Style -> Ordering
$ccompare :: Style -> Style -> Ordering
$cp1Ord :: Eq Style
Ord, Int -> Style -> ShowS
[Style] -> ShowS
Style -> String
(Int -> Style -> ShowS)
-> (Style -> String) -> ([Style] -> ShowS) -> Show Style
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Style] -> ShowS
$cshowList :: [Style] -> ShowS
show :: Style -> String
$cshow :: Style -> String
showsPrec :: Int -> Style -> ShowS
$cshowsPrec :: Int -> Style -> ShowS
Show)

newtype Check = Check (Maybe String)
                  deriving (Check -> Check -> Bool
(Check -> Check -> Bool) -> (Check -> Check -> Bool) -> Eq Check
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Check -> Check -> Bool
$c/= :: Check -> Check -> Bool
== :: Check -> Check -> Bool
$c== :: Check -> Check -> Bool
Eq, Eq Check
Eq Check
-> (Check -> Check -> Ordering)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Bool)
-> (Check -> Check -> Check)
-> (Check -> Check -> Check)
-> Ord Check
Check -> Check -> Bool
Check -> Check -> Ordering
Check -> Check -> Check
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Check -> Check -> Check
$cmin :: Check -> Check -> Check
max :: Check -> Check -> Check
$cmax :: Check -> Check -> Check
>= :: Check -> Check -> Bool
$c>= :: Check -> Check -> Bool
> :: Check -> Check -> Bool
$c> :: Check -> Check -> Bool
<= :: Check -> Check -> Bool
$c<= :: Check -> Check -> Bool
< :: Check -> Check -> Bool
$c< :: Check -> Check -> Bool
compare :: Check -> Check -> Ordering
$ccompare :: Check -> Check -> Ordering
$cp1Ord :: Eq Check
Ord, Int -> Check -> ShowS
[Check] -> ShowS
Check -> String
(Int -> Check -> ShowS)
-> (Check -> String) -> ([Check] -> ShowS) -> Show Check
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Check] -> ShowS
$cshowList :: [Check] -> ShowS
show :: Check -> String
$cshow :: Check -> String
showsPrec :: Int -> Check -> ShowS
$cshowsPrec :: Int -> Check -> ShowS
Show)

{-| Number of characters used to indent. -}
type Indentation = Int

defaultStyle :: Style
defaultStyle :: Style
defaultStyle
  = Style :: Int
-> Float
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Style
Style{lineLengthLimit :: Int
lineLengthLimit = Int
80, ribbonsPerLine :: Float
ribbonsPerLine = Float
1,
          successiveEmptyLinesLimit :: Int
successiveEmptyLinesLimit = Int
1,
          classIndentation :: Int
classIndentation = PPHsMode -> Int
Source.classIndent PPHsMode
mode,
          doIndentation :: Int
doIndentation = PPHsMode -> Int
Source.doIndent PPHsMode
mode,
          caseIndentation :: Int
caseIndentation = PPHsMode -> Int
Source.caseIndent PPHsMode
mode,
          letIndentation :: Int
letIndentation = PPHsMode -> Int
Source.letIndent PPHsMode
mode,
          whereIndentation :: Int
whereIndentation = PPHsMode -> Int
Source.whereIndent PPHsMode
mode,
          onsideIndentation :: Int
onsideIndentation = PPHsMode -> Int
Source.onsideIndent PPHsMode
mode,
          orderImportDeclarations :: Bool
orderImportDeclarations = Bool
True, orderImportEntities :: Bool
orderImportEntities = Bool
True}
  where mode :: PPHsMode
mode = PPHsMode
Source.defaultMode

check :: Style -> Result.Result ()
check :: Style -> Result ()
check Style
style
  = case Maybe String
maybeError of
        Maybe String
Nothing -> () -> Result ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just String
message -> Error -> Result ()
forall a. Error -> Result a
Result.fatalError (Error -> Result ()) -> Error -> Result ()
forall a b. (a -> b) -> a -> b
$ String -> Error
Error.createStyleFormatError String
message
  where maybeError :: Maybe String
maybeError
          = case [String]
errorMessages of
                [] -> Maybe String
forall a. Maybe a
Nothing
                [String]
messages -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
Newline.joinSeparatedLines [String]
messages
        errorMessages :: [String]
errorMessages = (Check -> Maybe String) -> [Check] -> [String]
forall a b. (a -> Maybe b) -> [a] -> [b]
Maybe.mapMaybe Check -> Maybe String
unwrap ([Check] -> [String]) -> [Check] -> [String]
forall a b. (a -> b) -> a -> b
$ Style -> [Check]
createChecks Style
style
        unwrap :: Check -> Maybe String
unwrap (Check Maybe String
errorMessage) = Maybe String
errorMessage

createChecks :: Style -> [Check]
createChecks :: Style -> [Check]
createChecks Style
style
  = [[Check]] -> [Check]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[Check
lineLengthLimitCheck, Check
ribbonsPerLineCheck,
        Check
successiveEmptyLinesLimitCheck],
       [Check]
indentationChecks, [Check
onsideLessCheck]]
  where lineLengthLimitCheck :: Check
lineLengthLimitCheck
          = Bool -> [String] -> Check
createCheck (Int
rawLineLengthLimit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
              [String
"The line length limit must be positive, but it is ",
               Int -> String
forall a. Show a => a -> String
show Int
rawLineLengthLimit, String
"."]
        rawLineLengthLimit :: Int
rawLineLengthLimit = Style -> Int
lineLengthLimit Style
style
        ribbonsPerLineCheck :: Check
ribbonsPerLineCheck
          = Bool -> [String] -> Check
createCheck (Float
rawRibbonsPerLine Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
1)
              [String
"The ribbons per line ratio must be at least 1, but it is ",
               Float -> String
forall a. Show a => a -> String
show Float
rawRibbonsPerLine, String
"."]
        rawRibbonsPerLine :: Float
rawRibbonsPerLine = Style -> Float
ribbonsPerLine Style
style
        successiveEmptyLinesLimitCheck :: Check
successiveEmptyLinesLimitCheck
          = Bool -> [String] -> Check
createCheck (Int
rawSuccessiveEmptyLinesLimit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0)
              [String
"The successive empty lines limit must not be negative, ",
               String
"but it is ", Int -> String
forall a. Show a => a -> String
show Int
rawSuccessiveEmptyLinesLimit, String
"."]
        rawSuccessiveEmptyLinesLimit :: Int
rawSuccessiveEmptyLinesLimit = Style -> Int
successiveEmptyLinesLimit Style
style

        indentationChecks :: [Check]
indentationChecks = ((Int, String) -> Check) -> [(Int, String)] -> [Check]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, String) -> Check
forall a. (Ord a, Num a, Show a) => (a, String) -> Check
checkIndentation [(Int, String)]
indentations
        checkIndentation :: (a, String) -> Check
checkIndentation (a
indentation, String
name)
          = Bool -> [String] -> Check
createCheck (a
indentation a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0)
              [String
"The ", String
name, String
" indentation must be positive, but it is ",
               a -> String
forall a. Show a => a -> String
show a
indentation, String
"."]
        indentations :: [(Int, String)]
indentations
          = [(Int
rawClassIndentation, String
"class"), (Int
rawDoIndentation, String
"do"),
             (Int
rawCaseIndentation, String
"case"), (Int
rawLetIndentation, String
"let"),
             (Int
rawWhereIndentation, String
"where"), (Int
rawOnsideIndentation, String
onsideName)]
        rawClassIndentation :: Int
rawClassIndentation = Style -> Int
classIndentation Style
style
        rawDoIndentation :: Int
rawDoIndentation = Style -> Int
doIndentation Style
style
        rawCaseIndentation :: Int
rawCaseIndentation = Style -> Int
caseIndentation Style
style
        rawLetIndentation :: Int
rawLetIndentation = Style -> Int
letIndentation Style
style
        rawWhereIndentation :: Int
rawWhereIndentation = Style -> Int
whereIndentation Style
style
        rawOnsideIndentation :: Int
rawOnsideIndentation = Style -> Int
onsideIndentation Style
style
        onsideName :: String
onsideName = String
"onside"
        onsideLessCheck :: Check
onsideLessCheck
          = Bool -> [String] -> Check
createCheck
              ([Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Bool) -> [Int] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
rawOnsideIndentation) [Int]
greaterOnsideIndentations)
              [String
"The ", String
onsideName,
               String
" indentation must be less than the other indentations, ",
               String
"but it is ", Int -> String
forall a. Show a => a -> String
show Int
rawOnsideIndentation, String
"."]
        greaterOnsideIndentations :: [Int]
greaterOnsideIndentations
          = [Int
rawClassIndentation, Int
rawDoIndentation, Int
rawCaseIndentation,
             Int
rawLetIndentation, Int
rawWhereIndentation]

createCheck :: Bool -> [String] -> Check
createCheck :: Bool -> [String] -> Check
createCheck Bool
False = Maybe String -> Check
Check (Maybe String -> Check)
-> ([String] -> Maybe String) -> [String] -> Check
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([String] -> String) -> [String] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
createCheck Bool
True = Check -> [String] -> Check
forall a b. a -> b -> a
const (Check -> [String] -> Check) -> Check -> [String] -> Check
forall a b. (a -> b) -> a -> b
$ Maybe String -> Check
Check Maybe String
forall a. Maybe a
Nothing