pretty-simple 1.1.0.2 → 1.1.0.3
raw patch · 4 files changed
+57/−45 lines, 4 filesdep −lensdep −mono-traversabledep −semigroups
Dependencies removed: lens, mono-traversable, semigroups
Files
- pretty-simple.cabal +1/−4
- src/Text/Pretty/Simple/Internal/ExprToOutput.hs +51/−33
- src/Text/Pretty/Simple/Internal/Output.hs +1/−3
- src/Text/Pretty/Simple/Internal/OutputPrinter.hs +4/−5
pretty-simple.cabal view
@@ -1,5 +1,5 @@ name: pretty-simple-version: 1.1.0.2+version: 1.1.0.3 synopsis: pretty printer for data types with a 'Show' instance. description: Please see <https://github.com/cdepillabout/pretty-simple#readme README.md>. homepage: https://github.com/cdepillabout/pretty-simple@@ -30,11 +30,8 @@ build-depends: base >= 4.8 && < 5 , ansi-terminal >= 0.6 , containers >= 0.5- , lens >= 4.13- , mono-traversable >= 0.10 , mtl >= 2.2 , parsec >= 3.1- , semigroups >= 0.18 , text >= 1.2 , transformers >= 0.4 default-language: Haskell2010
src/Text/Pretty/Simple/Internal/ExprToOutput.hs view
@@ -27,15 +27,13 @@ import Control.Applicative #endif -import Control.Lens ((<>=), (+=), (-=), use, view)-import Control.Lens.TH (makeLenses) import Control.Monad (when)-import Control.Monad.State (MonadState, execState)+import Control.Monad.State (MonadState, execState, gets, modify) import Data.Data (Data) import Data.Foldable (traverse_) import Data.Monoid ((<>))-import Data.Sequence (Seq)-import Data.Sequences (fromList, intersperse, singleton)+import Data.Sequence (Seq, fromList, singleton)+import Data.List (intersperse) import Data.Typeable (Typeable) import GHC.Generics (Generic) @@ -56,39 +54,47 @@ -- 'LineNum' will increase by 1. newtype LineNum = LineNum { unLineNum :: Int } deriving (Data, Eq, Generic, Num, Ord, Read, Show, Typeable)-makeLenses ''LineNum data PrinterState = PrinterState- { _currLine :: {-# UNPACK #-} !LineNum- , _nestLevel :: {-# UNPACK #-} !NestLevel- , _outputList :: !(Seq Output)+ { currLine :: {-# UNPACK #-} !LineNum+ , nestLevel :: {-# UNPACK #-} !NestLevel+ , outputList :: !(Seq Output) } deriving (Eq, Data, Generic, Show, Typeable)-makeLenses ''PrinterState -- | Smart-constructor for 'PrinterState'. printerState :: LineNum -> NestLevel -> Seq Output -> PrinterState printerState currLineNum nestNum output = PrinterState- { _currLine = currLineNum- , _nestLevel = nestNum- , _outputList = output+ { currLine = currLineNum+ , nestLevel = nestNum+ , outputList = output } +addToOutputList+ :: MonadState PrinterState m+ => Seq Output -> m ()+addToOutputList output =+ modify+ (\printState ->+ printState {outputList = outputList printState `mappend` output})+ addOutput :: MonadState PrinterState m => OutputType -> m () addOutput outputType = do- nest <- use nestLevel+ nest <- gets nestLevel let output = Output nest outputType- outputList <>= singleton output+ -- modify (over outputList (`mappend` singleton output))+ addToOutputList $ singleton output addOutputs :: MonadState PrinterState m => Seq OutputType -> m () addOutputs outputTypes = do- nest <- use nestLevel+ nest <- gets nestLevel let outputs = Output nest <$> outputTypes- outputList <>= outputs+ -- modify (over outputList (`mappend` outputs))+ addToOutputList outputs initPrinterState :: PrinterState initPrinterState = printerState 0 (-1) []@@ -99,13 +105,13 @@ -- markers. -- -- >>> testInit $ putSurroundExpr "[" "]" (CommaSeparated [])--- PrinterState {_currLine = LineNum {unLineNum = 0}, _nestLevel = NestLevel {_unNestLevel = -1}, _outputList = fromList [Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOpenBracket},Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputCloseBracket}]}+-- PrinterState {currLine = LineNum {unLineNum = 0}, nestLevel = NestLevel {unNestLevel = -1}, outputList = fromList [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBracket},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBracket}]} -- -- If there is only one expression, and it will print out on one line, then -- just print everything all on one line, with spaces around the expressions. -- -- >>> testInit $ putSurroundExpr "{" "}" (CommaSeparated [[Other "hello"]])--- PrinterState {_currLine = LineNum {unLineNum = 0}, _nestLevel = NestLevel {_unNestLevel = -1}, _outputList = fromList [Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOpenBrace},Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOther "hello"},Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputCloseBrace}]}+-- PrinterState {currLine = LineNum {unLineNum = 0}, nestLevel = NestLevel {unNestLevel = -1}, outputList = fromList [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOpenBrace},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "hello"},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " "},Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputCloseBrace}]} -- -- If there is only one expression, but it will print out on multiple lines, -- then go to newline and print out on multiple lines.@@ -125,11 +131,11 @@ -> CommaSeparated [Expr] -- ^ comma separated inner expression. -> m () putSurroundExpr startOutputType endOutputType (CommaSeparated []) = do- nestLevel += 1+ addToNestLevel 1 addOutputs [startOutputType, endOutputType]- nestLevel -= 1+ addToNestLevel (-1) putSurroundExpr startOutputType endOutputType (CommaSeparated [exprs]) = do- nestLevel += 1+ addToNestLevel 1 let isExprsMultiLine = howManyLines exprs > 1 when isExprsMultiLine $ do newLineAndDoIndent@@ -140,15 +146,15 @@ newLineAndDoIndent else addOutput $ OutputOther " " addOutput endOutputType- nestLevel -= 1+ addToNestLevel (-1) putSurroundExpr startOutputType endOutputType commaSeparated = do- nestLevel += 1+ addToNestLevel 1 newLineAndDoIndent addOutputs [startOutputType, OutputOther " "] putCommaSep commaSeparated newLineAndDoIndent addOutput endOutputType- nestLevel -= 1+ addToNestLevel (-1) addOutput $ OutputOther " " putCommaSep@@ -170,11 +176,11 @@ addOutputs [OutputComma, OutputOther " "] howManyLines :: [Expr] -> LineNum-howManyLines = view currLine . runInitPrinterState+howManyLines = currLine . runInitPrinterState doIndent :: MonadState PrinterState m => m () doIndent = do- nest <- use $ nestLevel . unNestLevel+ nest <- gets $ unNestLevel . nestLevel addOutputs . fromList $ replicate nest OutputIndent newLine@@ -182,13 +188,25 @@ => m () newLine = do addOutput OutputNewLine- currLine += 1+ addToCurrentLine 1 newLineAndDoIndent :: MonadState PrinterState m => m () newLineAndDoIndent = newLine >> doIndent +addToNestLevel+ :: MonadState PrinterState m+ => NestLevel -> m ()+addToNestLevel diff =+ modify (\printState -> printState {nestLevel = nestLevel printState + diff})++addToCurrentLine+ :: MonadState PrinterState m+ => LineNum -> m ()+addToCurrentLine diff =+ modify (\printState -> printState {currLine = currLine printState + diff})+ putExpression :: MonadState PrinterState m => Expr -> m () putExpression (Brackets commaSeparated) = do putSurroundExpr OutputOpenBracket OutputCloseBracket commaSeparated@@ -197,12 +215,12 @@ putExpression (Parens commaSeparated) = do putSurroundExpr OutputOpenParen OutputCloseParen commaSeparated putExpression (StringLit string) = do- nest <- use nestLevel- when (nest < 0) $ nestLevel += 1+ nest <- gets nestLevel+ when (nest < 0) $ addToNestLevel 1 addOutput $ OutputStringLit string putExpression (Other string) = do- nest <- use nestLevel- when (nest < 0) $ nestLevel += 1+ nest <- gets nestLevel+ when (nest < 0) $ addToNestLevel 1 addOutput $ OutputOther string runPrinterState :: PrinterState -> [Expr] -> PrinterState@@ -214,7 +232,7 @@ expressionsToOutputs :: [Expr] -> Seq Output expressionsToOutputs =- view outputList . runInitPrinterState . modificationsExprList+ outputList . runInitPrinterState . modificationsExprList -- | A function that performs optimizations and modifications to a list of -- input 'Expr's.
src/Text/Pretty/Simple/Internal/Output.hs view
@@ -27,7 +27,6 @@ import Control.Applicative #endif -import Control.Lens.TH (makeLenses) import Data.Data (Data) import Data.String (IsString, fromString) import Data.Typeable (Typeable)@@ -43,9 +42,8 @@ -- -- A 'NestLevel' of 2 would mean that an 'Output' token is two levels of -- brackets, etc.-newtype NestLevel = NestLevel { _unNestLevel :: Int }+newtype NestLevel = NestLevel { unNestLevel :: Int } deriving (Data, Eq, Generic, Num, Ord, Read, Show, Typeable)-makeLenses ''NestLevel -- | These are the output tokens that we will be printing to the screen. data OutputType
src/Text/Pretty/Simple/Internal/OutputPrinter.hs view
@@ -28,7 +28,6 @@ import Control.Monad.Reader (MonadReader(reader), runReader) import Data.Data (Data) import Data.Foldable (fold, foldlM)-import Data.Semigroup ((<>)) import Data.Text.Lazy (Text) import Data.Text.Lazy.Builder (Builder, fromString, toLazyText) import Data.Typeable (Typeable)@@ -123,7 +122,7 @@ -- | Remove a 'OutputNewLine' if it is the first item in the 'Output' list. -- -- >>> removeStartingNewLine [Output 3 OutputNewLine, Output 3 OutputComma]--- [Output {outputNestLevel = NestLevel {_unNestLevel = 3}, outputOutputType = OutputComma}]+-- [Output {outputNestLevel = NestLevel {unNestLevel = 3}, outputOutputType = OutputComma}] removeStartingNewLine :: [Output] -> [Output] removeStartingNewLine ((Output _ OutputNewLine) : t) = t removeStartingNewLine outputs = outputs@@ -132,18 +131,18 @@ -- one 'OutputOther'. -- -- >>> compressOthers [Output 0 (OutputOther "foo"), Output 0 (OutputOther "bar")]--- [Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOther "foobar"}]+-- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther "foobar"}] compressOthers :: [Output] -> [Output] compressOthers [] = [] compressOthers (Output _ (OutputOther string1):(Output nest (OutputOther string2)):t) =- compressOthers ((Output nest (OutputOther (string1 <> string2))) : t)+ compressOthers ((Output nest (OutputOther (string1 `mappend` string2))) : t) compressOthers (h:t) = h : compressOthers t -- | In each 'OutputOther' token, compress multiple whitespaces to just one -- whitespace. -- -- >>> shrinkWhitespaceInOthers [Output 0 (OutputOther " hello ")]--- [Output {outputNestLevel = NestLevel {_unNestLevel = 0}, outputOutputType = OutputOther " hello "}]+-- [Output {outputNestLevel = NestLevel {unNestLevel = 0}, outputOutputType = OutputOther " hello "}] shrinkWhitespaceInOthers :: [Output] -> [Output] shrinkWhitespaceInOthers = fmap shrinkWhitespaceInOther