{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

-- | Haskell indenter.
module Floskell
    ( -- * Configuration
      AppConfig(..)
    , defaultAppConfig
    , findAppConfig
    , findAppConfigIn
    , readAppConfig
    , setStyle
    , setLanguage
    , setExtensions
    , setFixities
      -- * Formatting functions.
    , reformat
      -- * Style
    , Style(..)
    , styles
      -- * Testing
    , defaultExtensions
    ) where

import           Data.ByteString.Lazy       ( ByteString )
import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy.UTF8  as UTF8
import           Data.List
import           Data.Maybe
#if __GLASGOW_HASKELL__ <= 802
import           Data.Monoid
#endif

import qualified Floskell.Buffer            as Buffer
import           Floskell.Comments
import           Floskell.Config
import           Floskell.ConfigFile
import           Floskell.Fixities          ( builtinFixities )
import           Floskell.Pretty            ( pretty )
import           Floskell.Styles            ( Style(..), styles )
import           Floskell.Types

import           Language.Haskell.Exts
                 hiding ( Comment, Pretty, Style, parse, prettyPrint, style )
import qualified Language.Haskell.Exts      as Exts

data CodeBlock = HaskellSource Int [ByteString] | CPPDirectives [ByteString]
    deriving ( Int -> CodeBlock -> ShowS
[CodeBlock] -> ShowS
CodeBlock -> String
(Int -> CodeBlock -> ShowS)
-> (CodeBlock -> String)
-> ([CodeBlock] -> ShowS)
-> Show CodeBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeBlock] -> ShowS
$cshowList :: [CodeBlock] -> ShowS
show :: CodeBlock -> String
$cshow :: CodeBlock -> String
showsPrec :: Int -> CodeBlock -> ShowS
$cshowsPrec :: Int -> CodeBlock -> ShowS
Show, CodeBlock -> CodeBlock -> Bool
(CodeBlock -> CodeBlock -> Bool)
-> (CodeBlock -> CodeBlock -> Bool) -> Eq CodeBlock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeBlock -> CodeBlock -> Bool
$c/= :: CodeBlock -> CodeBlock -> Bool
== :: CodeBlock -> CodeBlock -> Bool
$c== :: CodeBlock -> CodeBlock -> Bool
Eq )

trimBy :: (a -> Bool) -> [a] -> ([a], [a], [a])
trimBy :: (a -> Bool) -> [a] -> ([a], [a], [a])
trimBy a -> Bool
f [a]
xs = ([a]
prefix, [a]
middle, [a]
suffix)
  where
    ([a]
prefix, [a]
xs') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
f [a]
xs

    ([a]
suffix', [a]
middle') = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span a -> Bool
f ([a] -> ([a], [a])) -> [a] -> ([a], [a])
forall a b. (a -> b) -> a -> b
$ [a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs'

    middle :: [a]
middle = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
middle'

    suffix :: [a]
suffix = [a] -> [a]
forall a. [a] -> [a]
reverse [a]
suffix'

findLinePrefix :: (Char -> Bool) -> [ByteString] -> ByteString
findLinePrefix :: (Char -> Bool) -> [ByteString] -> ByteString
findLinePrefix Char -> Bool
_ [] = ByteString
""
findLinePrefix Char -> Bool
f (ByteString
x : [ByteString]
xs') = ByteString -> [ByteString] -> ByteString
forall (t :: * -> *).
Foldable t =>
ByteString -> t ByteString -> ByteString
go ((Char -> Bool) -> ByteString -> ByteString
L8.takeWhile Char -> Bool
f ByteString
x) [ByteString]
xs'
  where
    go :: ByteString -> t ByteString -> ByteString
go ByteString
prefix t ByteString
xs = if (ByteString -> Bool) -> t ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ByteString
prefix ByteString -> ByteString -> Bool
`L8.isPrefixOf`) t ByteString
xs
                   then ByteString
prefix
                   else ByteString -> t ByteString -> ByteString
go (Int64 -> ByteString -> ByteString
L8.take (ByteString -> Int64
L8.length ByteString
prefix Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
prefix) t ByteString
xs

findIndent :: (Char -> Bool) -> [ByteString] -> ByteString
findIndent :: (Char -> Bool) -> [ByteString] -> ByteString
findIndent Char -> Bool
_ [] = ByteString
""
findIndent Char -> Bool
f (ByteString
x : [ByteString]
xs') = ByteString -> [ByteString] -> ByteString
forall (t :: * -> *).
Foldable t =>
ByteString -> t ByteString -> ByteString
go ((Char -> Bool) -> ByteString -> ByteString
L8.takeWhile Char -> Bool
f ByteString
x) ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> Bool
L8.all Char -> Bool
f) [ByteString]
xs'
  where
    go :: ByteString -> t ByteString -> ByteString
go ByteString
indent t ByteString
xs = if (ByteString -> Bool) -> t ByteString -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (ByteString
indent ByteString -> ByteString -> Bool
`L8.isPrefixOf`) t ByteString
xs
                   then ByteString
indent
                   else ByteString -> t ByteString -> ByteString
go (Int64 -> ByteString -> ByteString
L8.take (ByteString -> Int64
L8.length ByteString
indent Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
1) ByteString
indent) t ByteString
xs

preserveVSpace :: Monad m
               => ([ByteString] -> m [ByteString])
               -> [ByteString]
               -> m [ByteString]
preserveVSpace :: ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
preserveVSpace [ByteString] -> m [ByteString]
format [ByteString]
input = do
    [ByteString]
output <- [ByteString] -> m [ByteString]
format [ByteString]
input'
    [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ [ByteString]
prefix [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
output [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
suffix
  where
    ([ByteString]
prefix, [ByteString]
input', [ByteString]
suffix) = (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a], [a])
trimBy ByteString -> Bool
L8.null [ByteString]
input

preservePrefix :: Monad m
               => (Int -> [ByteString] -> m [ByteString])
               -> [ByteString]
               -> m [ByteString]
preservePrefix :: (Int -> [ByteString] -> m [ByteString])
-> [ByteString] -> m [ByteString]
preservePrefix Int -> [ByteString] -> m [ByteString]
format [ByteString]
input = do
    [ByteString]
output <- Int -> [ByteString] -> m [ByteString]
format (ByteString -> Int
prefixLength ByteString
prefix) [ByteString]
input'
    [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) [ByteString]
output
  where
    prefix :: ByteString
prefix = (Char -> Bool) -> [ByteString] -> ByteString
findLinePrefix Char -> Bool
allowed [ByteString]
input

    input' :: [ByteString]
input' = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> ByteString -> ByteString
L8.drop (Int64 -> ByteString -> ByteString)
-> Int64 -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L8.length ByteString
prefix) [ByteString]
input

    allowed :: Char -> Bool
allowed Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'>'

    prefixLength :: ByteString -> Int
prefixLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (ByteString -> [Int]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then Int
8 else Int
1) (String -> [Int]) -> (ByteString -> String) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
L8.unpack

preserveIndent :: Monad m
               => (Int -> [ByteString] -> m [ByteString])
               -> [ByteString]
               -> m [ByteString]
preserveIndent :: (Int -> [ByteString] -> m [ByteString])
-> [ByteString] -> m [ByteString]
preserveIndent Int -> [ByteString] -> m [ByteString]
format [ByteString]
input = do
    [ByteString]
output <- Int -> [ByteString] -> m [ByteString]
format (ByteString -> Int
prefixLength ByteString
prefix) [ByteString]
input'
    [ByteString] -> m [ByteString]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString
prefix ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<>) [ByteString]
output
  where
    prefix :: ByteString
prefix = (Char -> Bool) -> [ByteString] -> ByteString
findIndent Char -> Bool
allowed [ByteString]
input

    input' :: [ByteString]
input' = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (Int64 -> ByteString -> ByteString
L8.drop (Int64 -> ByteString -> ByteString)
-> Int64 -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L8.length ByteString
prefix) [ByteString]
input

    allowed :: Char -> Bool
allowed Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'

    prefixLength :: ByteString -> Int
prefixLength = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (ByteString -> [Int]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' then Int
8 else Int
1) (String -> [Int]) -> (ByteString -> String) -> ByteString -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
L8.unpack

withReducedLineLength :: Int -> Config -> Config
withReducedLineLength :: Int -> Config -> Config
withReducedLineLength Int
offset Config
config = Config
config { cfgPenalty :: PenaltyConfig
cfgPenalty = PenaltyConfig
penalty }
  where
    penalty :: PenaltyConfig
penalty = (Config -> PenaltyConfig
cfgPenalty Config
config) { penaltyMaxLineLength :: Int
penaltyMaxLineLength =
                                        PenaltyConfig -> Int
penaltyMaxLineLength (Config -> PenaltyConfig
cfgPenalty Config
config)
                                        Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
offset
                                  }

-- | Format the given source.
reformat
    :: AppConfig -> Maybe FilePath -> ByteString -> Either String ByteString
reformat :: AppConfig -> Maybe String -> ByteString -> Either String ByteString
reformat AppConfig
config Maybe String
mfilepath ByteString
input = ([ByteString] -> ByteString)
-> Either String [ByteString] -> Either String ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> [ByteString] -> ByteString
L8.intercalate ByteString
"\n")
    (Either String [ByteString] -> Either String ByteString)
-> ([ByteString] -> Either String [ByteString])
-> [ByteString]
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall (m :: * -> *).
Monad m =>
([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
preserveVSpace ((Int -> [ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall (m :: * -> *).
Monad m =>
(Int -> [ByteString] -> m [ByteString])
-> [ByteString] -> m [ByteString]
preservePrefix (ParseMode
-> Config -> Int -> [ByteString] -> Either String [ByteString]
reformatLines ParseMode
mode Config
cfg)) ([ByteString] -> Either String ByteString)
-> [ByteString] -> Either String ByteString
forall a b. (a -> b) -> a -> b
$
    Char -> ByteString -> [ByteString]
L8.split Char
'\n' ByteString
input
  where
    mode :: ParseMode
mode = case String -> Maybe (Maybe Language, [Extension])
readExtensions (String -> Maybe (Maybe Language, [Extension]))
-> String -> Maybe (Maybe Language, [Extension])
forall a b. (a -> b) -> a -> b
$ ByteString -> String
UTF8.toString ByteString
input of
        Maybe (Maybe Language, [Extension])
Nothing -> ParseMode
mode'
        Just (Maybe Language
Nothing, [Extension]
exts') ->
            ParseMode
mode' { extensions :: [Extension]
extensions = [Extension]
exts' [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ ParseMode -> [Extension]
extensions ParseMode
mode' }
        Just (Just Language
lang, [Extension]
exts') ->
            ParseMode
mode' { baseLanguage :: Language
baseLanguage = Language
lang
                  , extensions :: [Extension]
extensions   = [Extension]
exts' [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ ParseMode -> [Extension]
extensions ParseMode
mode'
                  }

    mode' :: ParseMode
mode' = ParseMode
defaultParseMode { parseFilename :: String
parseFilename = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"<stdin>" Maybe String
mfilepath
                             , baseLanguage :: Language
baseLanguage  = AppConfig -> Language
appLanguage AppConfig
config
                             , extensions :: [Extension]
extensions    = AppConfig -> [Extension]
appExtensions AppConfig
config
                             , fixities :: Maybe [Fixity]
fixities      =
                                   [Fixity] -> Maybe [Fixity]
forall a. a -> Maybe a
Just ([Fixity] -> Maybe [Fixity]) -> [Fixity] -> Maybe [Fixity]
forall a b. (a -> b) -> a -> b
$ AppConfig -> [Fixity]
appFixities AppConfig
config [Fixity] -> [Fixity] -> [Fixity]
forall a. [a] -> [a] -> [a]
++ [Fixity]
builtinFixities
                             }

    cfg :: Config
cfg = Config -> Config
safeConfig (Config -> Config) -> (Style -> Config) -> Style -> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Style -> Config
styleConfig (Style -> Config) -> Style -> Config
forall a b. (a -> b) -> a -> b
$ AppConfig -> Style
appStyle AppConfig
config

reformatLines
    :: ParseMode -> Config -> Int -> [ByteString] -> Either String [ByteString]
reformatLines :: ParseMode
-> Config -> Int -> [ByteString] -> Either String [ByteString]
reformatLines ParseMode
mode Config
config Int
indent = ([ByteString], [Comment]) -> Either String [ByteString]
format (([ByteString], [Comment]) -> Either String [ByteString])
-> ([ByteString] -> ([ByteString], [Comment]))
-> [ByteString]
-> Either String [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ([ByteString], [Comment])
filterPreprocessorDirectives
  where
    config' :: Config
config' = Int -> Config -> Config
withReducedLineLength Int
indent Config
config

    format :: ([ByteString], [Comment]) -> Either String [ByteString]
format ([ByteString]
code, [Comment]
comments) =
        ([ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall (m :: * -> *).
Monad m =>
([ByteString] -> m [ByteString]) -> [ByteString] -> m [ByteString]
preserveVSpace ((Int -> [ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall (m :: * -> *).
Monad m =>
(Int -> [ByteString] -> m [ByteString])
-> [ByteString] -> m [ByteString]
preserveIndent (ParseMode
-> Config
-> [Comment]
-> Int
-> [ByteString]
-> Either String [ByteString]
reformatBlock ParseMode
mode Config
config' [Comment]
comments))
                       [ByteString]
code

-- | Format a continuous block of code without CPP directives.
reformatBlock :: ParseMode
              -> Config
              -> [Comment]
              -> Int
              -> [ByteString]
              -> Either String [ByteString]
reformatBlock :: ParseMode
-> Config
-> [Comment]
-> Int
-> [ByteString]
-> Either String [ByteString]
reformatBlock ParseMode
mode Config
config [Comment]
cpp Int
indent [ByteString]
lines =
    case ParseMode -> String -> ParseResult (Module SrcSpanInfo, [Comment])
parseModuleWithComments ParseMode
mode String
code of
        ParseOk (Module SrcSpanInfo
m, [Comment]
comments') ->
            let comments :: [Comment]
comments = (Comment -> Comment) -> [Comment] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map Comment -> Comment
makeComment [Comment]
comments'
                ast :: Module NodeInfo
ast = Module SrcSpanInfo -> [Comment] -> Module NodeInfo
forall (ast :: * -> *).
Traversable ast =>
ast SrcSpanInfo -> [Comment] -> ast NodeInfo
annotateWithComments Module SrcSpanInfo
m ([Comment] -> [Comment] -> [Comment]
mergeComments [Comment]
comments [Comment]
cpp)
            in
                case Printer () -> Config -> Maybe ByteString
forall a. Printer a -> Config -> Maybe ByteString
prettyPrint (Module NodeInfo -> Printer ()
forall (ast :: * -> *).
(Annotated ast, Pretty ast) =>
ast NodeInfo -> Printer ()
pretty Module NodeInfo
ast) Config
config' of
                    Maybe ByteString
Nothing -> String -> Either String [ByteString]
forall a b. a -> Either a b
Left String
"Printer failed with mzero call."
                    Just ByteString
output -> [ByteString] -> Either String [ByteString]
forall a b. b -> Either a b
Right ([ByteString] -> Either String [ByteString])
-> [ByteString] -> Either String [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L8.lines ByteString
output
        ParseFailed SrcLoc
loc String
e -> String -> Either String [ByteString]
forall a b. a -> Either a b
Left (String -> Either String [ByteString])
-> String -> Either String [ByteString]
forall a b. (a -> b) -> a -> b
$
            SrcLoc -> String
forall a. Pretty a => a -> String
Exts.prettyPrint (SrcLoc
loc { srcLine :: Int
srcLine = SrcLoc -> Int
srcLine SrcLoc
loc }) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
e
  where
    code :: String
code = ByteString -> String
UTF8.toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
L8.intercalate ByteString
"\n" [ByteString]
lines

    config' :: Config
config' = Int -> Config -> Config
withReducedLineLength Int
indent Config
config

    makeComment :: Comment -> Comment
makeComment (Exts.Comment Bool
inline SrcSpan
span String
text) =
        CommentType -> SrcSpan -> String -> Comment
Comment (if Bool
inline then CommentType
InlineComment else CommentType
LineComment) SrcSpan
span String
text

    mergeComments :: [Comment] -> [Comment] -> [Comment]
mergeComments [Comment]
xs [] = [Comment]
xs
    mergeComments [] [Comment]
ys = [Comment]
ys
    mergeComments xs :: [Comment]
xs@(Comment
x : [Comment]
xs') ys :: [Comment]
ys@(Comment
y : [Comment]
ys') =
        if SrcSpan -> Int
srcSpanStartLine (Comment -> SrcSpan
commentSpan Comment
x) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< SrcSpan -> Int
srcSpanStartLine (Comment -> SrcSpan
commentSpan Comment
y)
        then Comment
x Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: [Comment] -> [Comment] -> [Comment]
mergeComments [Comment]
xs' [Comment]
ys
        else Comment
y Comment -> [Comment] -> [Comment]
forall a. a -> [a] -> [a]
: [Comment] -> [Comment] -> [Comment]
mergeComments [Comment]
xs [Comment]
ys'

-- | Remove CPP directives from input source, retur
filterPreprocessorDirectives :: [ByteString] -> ([ByteString], [Comment])
filterPreprocessorDirectives :: [ByteString] -> ([ByteString], [Comment])
filterPreprocessorDirectives [ByteString]
lines = ([ByteString]
code, [Comment]
comments)
  where
    code :: [ByteString]
code = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
l -> if ByteString -> Bool
cppLine ByteString
l then ByteString
"" else ByteString
l) [ByteString]
lines

    comments :: [Comment]
comments = ((Int, ByteString) -> Comment) -> [(Int, ByteString)] -> [Comment]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ByteString) -> Comment
makeComment ([(Int, ByteString)] -> [Comment])
-> ([(Int, ByteString)] -> [(Int, ByteString)])
-> [(Int, ByteString)]
-> [Comment]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, ByteString) -> Bool)
-> [(Int, ByteString)] -> [(Int, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> Bool
cppLine (ByteString -> Bool)
-> ((Int, ByteString) -> ByteString) -> (Int, ByteString) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> ByteString
forall a b. (a, b) -> b
snd) ([(Int, ByteString)] -> [Comment])
-> [(Int, ByteString)] -> [Comment]
forall a b. (a -> b) -> a -> b
$ [Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ Int
1 .. ] [ByteString]
lines

    makeComment :: (Int, ByteString) -> Comment
makeComment (Int
n, ByteString
l) =
        CommentType -> SrcSpan -> String -> Comment
Comment CommentType
PreprocessorDirective
                (String -> Int -> Int -> Int -> Int -> SrcSpan
SrcSpan String
"" Int
n Int
1 Int
n (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
L8.length ByteString
l Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
1))
                (ByteString -> String
L8.unpack ByteString
l)

    cppLine :: ByteString -> Bool
cppLine ByteString
src =
        (ByteString -> Bool) -> [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ByteString -> ByteString -> Bool
`L8.isPrefixOf` ByteString
src)
            [ ByteString
"#if"
            , ByteString
"#end"
            , ByteString
"#else"
            , ByteString
"#define"
            , ByteString
"#undef"
            , ByteString
"#elif"
            , ByteString
"#include"
            , ByteString
"#error"
            , ByteString
"#warning"
            ]

prettyPrint :: Printer a -> Config -> Maybe ByteString
prettyPrint :: Printer a -> Config -> Maybe ByteString
prettyPrint Printer a
printer = ((Penalty, PrintState) -> ByteString)
-> Maybe (Penalty, PrintState) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Buffer -> ByteString
Buffer.toLazyByteString (Buffer -> ByteString)
-> ((Penalty, PrintState) -> Buffer)
-> (Penalty, PrintState)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrintState -> Buffer
psBuffer (PrintState -> Buffer)
-> ((Penalty, PrintState) -> PrintState)
-> (Penalty, PrintState)
-> Buffer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Penalty, PrintState) -> PrintState
forall a b. (a, b) -> b
snd)
    (Maybe (Penalty, PrintState) -> Maybe ByteString)
-> (Config -> Maybe (Penalty, PrintState))
-> Config
-> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Printer a -> PrintState -> Maybe (Penalty, PrintState)
forall a. Printer a -> PrintState -> Maybe (Penalty, PrintState)
execPrinter Printer a
printer (PrintState -> Maybe (Penalty, PrintState))
-> (Config -> PrintState) -> Config -> Maybe (Penalty, PrintState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> PrintState
initialPrintState

-- | Default extensions.
defaultExtensions :: [Extension]
defaultExtensions :: [Extension]
defaultExtensions = [ Extension
e | e :: Extension
e@EnableExtension{} <- [Extension]
knownExtensions ]
    [Extension] -> [Extension] -> [Extension]
forall a. Eq a => [a] -> [a] -> [a]
\\ (KnownExtension -> Extension) -> [KnownExtension] -> [Extension]
forall a b. (a -> b) -> [a] -> [b]
map KnownExtension -> Extension
EnableExtension [KnownExtension]
badExtensions

-- | Extensions which steal too much syntax.
badExtensions :: [KnownExtension]
badExtensions :: [KnownExtension]
badExtensions =
    [ KnownExtension
Arrows -- steals proc
    , KnownExtension
TransformListComp -- steals the group keyword
    , KnownExtension
XmlSyntax
    , KnownExtension
RegularPatterns -- steals a-b
    , KnownExtension
UnboxedTuples -- breaks (#) lens operator
    , KnownExtension
PatternSynonyms -- steals the pattern keyword
    , KnownExtension
RecursiveDo -- steals the rec keyword
    , KnownExtension
DoRec -- same
    , KnownExtension
TypeApplications -- since GHC 8 and haskell-src-exts-1.19
    ]