<commit_before>{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Floskell.Pretty ( Pretty(..), pretty ) where

import           Control.Applicative          ( (<|>) )
import           Control.Monad
                 ( forM_, guard, replicateM_, unless, void, when )
import           Control.Monad.State.Strict   ( get, gets, modify )

import           Data.ByteString              ( ByteString )
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Char8        as BS8
import qualified Data.ByteString.Lazy         as BL

import           Data.List                    ( groupBy, sortBy, sortOn )
import           Data.Maybe                   ( catMaybes, fromMaybe )

import qualified Floskell.Buffer              as Buffer
import           Floskell.Config
import           Floskell.Imports
                 ( groupImports, sortImports, splitImports )
import           Floskell.Printers
import           Floskell.Types

import qualified Language.Haskell.Exts.Pretty as HSE
import           Language.Haskell.Exts.Syntax

-- | Like `span`, but comparing adjacent items.
run :: (a -> a -> Bool) -> [a] -> ([a], [a])
run _ [] = ([], [])
run _ [ x ] = ([ x ], [])
run eq (x : y : xs)
    | eq x y = let (ys, zs) = run eq (y : xs) in (x : ys, zs)
    | otherwise = ([ x ], y : xs)

-- | Like `groupBy`, but comparing adjacent items.
runs :: (a -> a -> Bool) -> [a] -> [[a]]
runs _ [] = []
runs eq xs = let (ys, zs) = run eq xs in ys : runs eq zs

stopImportModule :: TabStop
stopImportModule = TabStop "import-module"

stopImportSpec :: TabStop
stopImportSpec = TabStop "import-spec"

stopRecordField :: TabStop
stopRecordField = TabStop "record"

stopRhs :: TabStop
stopRhs = TabStop "rhs"

flattenApp :: Annotated ast
           => (ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
           -> ast NodeInfo
           -> [ast NodeInfo]
flattenApp fn = go . amap (\info -> info { nodeInfoLeadingComments  = []
                                         , nodeInfoTrailingComments = []
                                         })
  where
    go x = case fn x of
        Just (lhs, rhs) -> let lhs' = go $ copyComments Before x lhs
                               rhs' = go $ copyComments After x rhs
                           in
                               lhs' ++ rhs'
        Nothing -> [ x ]

flattenInfix
    :: (Annotated ast1, Annotated ast2)
    => (ast1 NodeInfo -> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
    -> ast1 NodeInfo
    -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix fn = go . amap (\info -> info { nodeInfoLeadingComments  = []
                                           , nodeInfoTrailingComments = []
                                           })
  where
    go x = case fn x of
        Just (lhs, op, rhs) ->
            let (lhs', ops) = go $ copyComments Before x lhs
                (lhs'', ops') = go $ copyComments After x rhs
            in
                (lhs', ops ++ (op, lhs'') : ops')
        Nothing -> (x, [])

-- | Syntax shortcut for Pretty Printers.
type PrettyPrinter f = f NodeInfo -> Printer ()

-- | Pretty printing prettyHSE using haskell-src-exts pretty printer
prettyHSE :: HSE.Pretty (ast NodeInfo) => PrettyPrinter ast
prettyHSE ast = string $ HSE.prettyPrint ast

-- | Type class for pretty-printable types.
class Pretty ast where
    prettyPrint :: PrettyPrinter ast
    default prettyPrint :: HSE.Pretty (ast NodeInfo) => PrettyPrinter ast
    prettyPrint = prettyHSE

-- | Pretty print a syntax tree with annotated comments
pretty :: (Annotated ast, Pretty ast) => PrettyPrinter ast
pretty ast = do
    printComments Before ast
    prettyPrint ast
    printComments After ast

prettyOnside :: (Annotated ast, Pretty ast) => PrettyPrinter ast
prettyOnside ast = do
    eol <- gets psEolComment
    when eol newline
    nl <- gets psNewline
    if nl
        then do
            printComments Before ast
            onside $ prettyPrint ast
            printComments After ast
        else onside $ pretty ast

-- | Compare two AST nodes ignoring the annotation
compareAST :: (Functor ast, Ord (ast ()))
           => ast NodeInfo
           -> ast NodeInfo
           -> Ordering
compareAST a b = void a `compare` void b

-- | Return leading comments.
filterComments :: Annotated a => Location -> a NodeInfo -> [Comment]
filterComments Before = nodeInfoLeadingComments . ann
filterComments After = nodeInfoTrailingComments . ann

-- | Copy comments from one AST node to another.
copyComments :: (Annotated ast1, Annotated ast2)
             => Location<commit_msg>Remove PrettyPrinter type alias<commit_after>{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

module Floskell.Pretty ( Pretty(..), pretty ) where

import           Control.Applicative          ( (<|>) )
import           Control.Monad
                 ( forM_, guard, replicateM_, unless, void, when )
import           Control.Monad.State.Strict   ( get, gets, modify )

import           Data.ByteString              ( ByteString )
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Char8        as BS8
import qualified Data.ByteString.Lazy         as BL
import           Data.List                    ( groupBy, sortBy, sortOn )
import           Data.Maybe                   ( catMaybes, fromMaybe )

import qualified Floskell.Buffer              as Buffer
import           Floskell.Config
import           Floskell.Imports
                 ( groupImports, sortImports, splitImports )
import           Floskell.Printers
import           Floskell.Types

import qualified Language.Haskell.Exts.Pretty as HSE
import           Language.Haskell.Exts.Syntax

-- | Like `span`, but comparing adjacent items.
run :: (a -> a -> Bool) -> [a] -> ([a], [a])
run _ [] = ([], [])
run _ [ x ] = ([ x ], [])
run eq (x : y : xs)
    | eq x y = let (ys, zs) = run eq (y : xs) in (x : ys, zs)
    | otherwise = ([ x ], y : xs)

-- | Like `groupBy`, but comparing adjacent items.
runs :: (a -> a -> Bool) -> [a] -> [[a]]
runs _ [] = []
runs eq xs = let (ys, zs) = run eq xs in ys : runs eq zs

stopImportModule :: TabStop
stopImportModule = TabStop "import-module"

stopImportSpec :: TabStop
stopImportSpec = TabStop "import-spec"

stopRecordField :: TabStop
stopRecordField = TabStop "record"

stopRhs :: TabStop
stopRhs = TabStop "rhs"

flattenApp :: Annotated ast
           => (ast NodeInfo -> Maybe (ast NodeInfo, ast NodeInfo))
           -> ast NodeInfo
           -> [ast NodeInfo]
flattenApp fn = go . amap (\info -> info { nodeInfoLeadingComments  = []
                                         , nodeInfoTrailingComments = []
                                         })
  where
    go x = case fn x of
        Just (lhs, rhs) -> let lhs' = go $ copyComments Before x lhs
                               rhs' = go $ copyComments After x rhs
                           in
                               lhs' ++ rhs'
        Nothing -> [ x ]

flattenInfix
    :: (Annotated ast1, Annotated ast2)
    => (ast1 NodeInfo -> Maybe (ast1 NodeInfo, ast2 NodeInfo, ast1 NodeInfo))
    -> ast1 NodeInfo
    -> (ast1 NodeInfo, [(ast2 NodeInfo, ast1 NodeInfo)])
flattenInfix fn = go . amap (\info -> info { nodeInfoLeadingComments  = []
                                           , nodeInfoTrailingComments = []
                                           })
  where
    go x = case fn x of
        Just (lhs, op, rhs) ->
            let (lhs', ops) = go $ copyComments Before x lhs
                (lhs'', ops') = go $ copyComments After x rhs
            in
                (lhs', ops ++ (op, lhs'') : ops')
        Nothing -> (x, [])

-- | Pretty printing prettyHSE using haskell-src-exts pretty printer
prettyHSE :: HSE.Pretty (ast NodeInfo) => ast NodeInfo -> Printer ()
prettyHSE ast = string $ HSE.prettyPrint ast

-- | Type class for pretty-printable types.
class Pretty ast where
    prettyPrint :: ast NodeInfo -> Printer ()
    default prettyPrint :: HSE.Pretty (ast NodeInfo)
                        => ast NodeInfo
                        -> Printer ()
    prettyPrint = prettyHSE

-- | Pretty print a syntax tree with annotated comments
pretty :: (Annotated ast, Pretty ast) => ast NodeInfo -> Printer ()
pretty ast = do
    printComments Before ast
    prettyPrint ast
    printComments After ast

prettyOnside :: (Annotated ast, Pretty ast) => ast NodeInfo -> Printer ()
prettyOnside ast = do
    eol <- gets psEolComment
    when eol newline
    nl <- gets psNewline
    if nl
        then do
            printComments Before ast
            onside $ prettyPrint ast
            printComments After ast
        else onside $ pretty ast

-- | Compare two AST nodes ignoring the annotation
compareAST :: (Functor ast, Ord (ast ()))
           => ast NodeInfo
           -> ast NodeInfo
           -> Ordering
compareAST a b = void a `compare` void b

-- | Return leading comments.
filterComments :: Annotated a => Location -> a NodeInfo -> [Comment]
filterComments Before = nodeInfoLeadingComments . ann
filterComments After = nodeInfoTrailingComments . ann

-- | Copy comments from one AST node to another.
copyComments :: (Annotated ast1, Annotated ast2)
             => Location
{'fraction_non_alphanumeric': 0.10255594442676848, 'fraction_numerical': 0.002969561989606533, 'mean_word_length': 1.9860671310956302, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 77, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 16, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '200390', 'n_tokens_mistral': 2783, 'n_tokens_neox': 2671, 'n_words': 898}