mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-23 16:28:02 +03:00
newtype Width to avoid shenanigans
This commit is contained in:
parent
5b672cd815
commit
02aa20cdca
@ -1557,11 +1557,17 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
|||||||
(types `zip` [0..])
|
(types `zip` [0..])
|
||||||
<*> traverse prettyGroup (terms `zip` [length types ..])
|
<*> traverse prettyGroup (terms `zip` [length types ..])
|
||||||
where
|
where
|
||||||
leftNamePad :: Int = foldl1' max $
|
leftNamePad :: P.Width =
|
||||||
map (foldl1' max . map HQ'.nameLength . toList . view _3) terms <>
|
foldl1' max
|
||||||
map (foldl1' max . map HQ'.nameLength . toList . view _3) types
|
$ map (foldl1' max . map (P.Width . HQ'.nameLength) . toList . view _3)
|
||||||
prettyGroup :: ((Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name)), Int)
|
terms
|
||||||
-> Numbered Pretty
|
<> map (foldl1' max . map (P.Width . HQ'.nameLength) . toList . view _3)
|
||||||
|
types
|
||||||
|
prettyGroup
|
||||||
|
:: ( (Referent, b, Set (HQ'.HashQualified Name), Set (HQ'.HashQualified Name))
|
||||||
|
, Int
|
||||||
|
)
|
||||||
|
-> Numbered Pretty
|
||||||
prettyGroup ((r, _, olds, news),i) = let
|
prettyGroup ((r, _, olds, news),i) = let
|
||||||
-- [ "peach ┐"
|
-- [ "peach ┐"
|
||||||
-- , "peach' ┘"]
|
-- , "peach' ┘"]
|
||||||
@ -1737,29 +1743,38 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
|||||||
|
|
||||||
-- + 2. MIT : License
|
-- + 2. MIT : License
|
||||||
-- - 3. AllRightsReserved : License
|
-- - 3. AllRightsReserved : License
|
||||||
mdTermLine :: Path.Absolute -> Int -> OBD.TermDisplay v a -> Numbered (Pretty, Pretty)
|
mdTermLine
|
||||||
|
:: Path.Absolute
|
||||||
|
-> P.Width
|
||||||
|
-> OBD.TermDisplay v a
|
||||||
|
-> Numbered (Pretty, Pretty)
|
||||||
mdTermLine p namesWidth (hq, r, otype, mddiff) = do
|
mdTermLine p namesWidth (hq, r, otype, mddiff) = do
|
||||||
n <- numHQ' p hq r
|
n <- numHQ' p hq r
|
||||||
fmap ((n,) . P.linesNonEmpty) . sequence $
|
fmap ((n, ) . P.linesNonEmpty)
|
||||||
[ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
|
. sequence
|
||||||
, prettyMetadataDiff mddiff ]
|
$ [ pure $ P.rightPad namesWidth (phq' hq) <> " : " <> prettyType otype
|
||||||
-- , P.indentN 2 <$> prettyMetadataDiff mddiff ]
|
, prettyMetadataDiff mddiff
|
||||||
|
]
|
||||||
|
|
||||||
prettyUpdateTerm :: OBD.UpdateTermDisplay v a -> Numbered Pretty
|
prettyUpdateTerm :: OBD.UpdateTermDisplay v a -> Numbered Pretty
|
||||||
prettyUpdateTerm (Nothing, newTerms) =
|
prettyUpdateTerm (Nothing, newTerms) = if null newTerms
|
||||||
if null newTerms then error "Super invalid UpdateTermDisplay" else
|
then error "Super invalid UpdateTermDisplay"
|
||||||
fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
|
else fmap P.column2 $ traverse (mdTermLine newPath namesWidth) newTerms
|
||||||
where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) newTerms
|
where
|
||||||
prettyUpdateTerm (Just olds, news) =
|
namesWidth = foldl1' max $ fmap (P.Width . HQ'.nameLength . view _1) newTerms
|
||||||
fmap P.column2 $ do
|
prettyUpdateTerm (Just olds, news) = fmap P.column2 $ do
|
||||||
olds <- traverse (mdTermLine oldPath namesWidth) [ (name,r,typ,mempty) | (name,r,typ) <- olds ]
|
olds <- traverse (mdTermLine oldPath namesWidth)
|
||||||
news <- traverse (mdTermLine newPath namesWidth) news
|
[ (name, r, typ, mempty) | (name, r, typ) <- olds ]
|
||||||
let (oldnums, olddatas) = unzip olds
|
news <- traverse (mdTermLine newPath namesWidth) news
|
||||||
let (newnums, newdatas) = unzip news
|
let (oldnums, olddatas) = unzip olds
|
||||||
pure $ zip (oldnums <> [""] <> newnums)
|
let (newnums, newdatas) = unzip news
|
||||||
(P.boxLeft olddatas <> [downArrow] <> P.boxLeft newdatas)
|
pure $ zip (oldnums <> [""] <> newnums)
|
||||||
where namesWidth = foldl1' max $ fmap (HQ'.nameLength . view _1) news
|
(P.boxLeft olddatas <> [downArrow] <> P.boxLeft newdatas)
|
||||||
<> fmap (HQ'.nameLength . view _1) olds
|
where
|
||||||
|
namesWidth =
|
||||||
|
foldl1' max
|
||||||
|
$ fmap (P.Width . HQ'.nameLength . view _1) news
|
||||||
|
<> fmap (P.Width . HQ'.nameLength . view _1) olds
|
||||||
|
|
||||||
prettyMetadataDiff :: OBD.MetadataDiff (OBD.MetadataDisplay v a) -> Numbered Pretty
|
prettyMetadataDiff :: OBD.MetadataDiff (OBD.MetadataDisplay v a) -> Numbered Pretty
|
||||||
prettyMetadataDiff OBD.MetadataDiff{..} = P.column2M $
|
prettyMetadataDiff OBD.MetadataDiff{..} = P.column2M $
|
||||||
@ -1803,7 +1818,7 @@ showDiffNamespace sn ppe oldPath newPath OBD.BranchDiffOutput{..} =
|
|||||||
padNumber :: Int -> Pretty
|
padNumber :: Int -> Pretty
|
||||||
padNumber n = P.hiBlack . P.rightPad leftNumsWidth $ P.shown n <> "."
|
padNumber n = P.hiBlack . P.rightPad leftNumsWidth $ P.shown n <> "."
|
||||||
|
|
||||||
leftNumsWidth = length (show menuSize) + length ("." :: String)
|
leftNumsWidth = P.Width $ length (show menuSize) + length ("." :: String)
|
||||||
|
|
||||||
noResults :: Pretty
|
noResults :: Pretty
|
||||||
noResults = P.callout "😶" $
|
noResults = P.callout "😶" $
|
||||||
@ -1907,7 +1922,7 @@ watchPrinter src ppe ann kind term isHit =
|
|||||||
[ fromString (replicate lineNumWidth ' ')
|
[ fromString (replicate lineNumWidth ' ')
|
||||||
<> fromString extra
|
<> fromString extra
|
||||||
<> (if isHit then id else P.purple) "⧩"
|
<> (if isHit then id else P.purple) "⧩"
|
||||||
, P.indentN (lineNumWidth + length extra)
|
, P.indentN (P.Width (lineNumWidth + length extra))
|
||||||
. (if isHit then id else P.bold)
|
. (if isHit then id else P.bold)
|
||||||
$ TermPrinter.pretty ppe term
|
$ TermPrinter.pretty ppe term
|
||||||
]
|
]
|
||||||
|
@ -28,23 +28,23 @@ putPrettyLn' :: P.Pretty CT.ColorText -> IO ()
|
|||||||
putPrettyLn' p | p == mempty = pure ()
|
putPrettyLn' p | p == mempty = pure ()
|
||||||
putPrettyLn' p = do
|
putPrettyLn' p = do
|
||||||
width <- getAvailableWidth
|
width <- getAvailableWidth
|
||||||
less . P.toANSI width $ p
|
less $ P.toANSI width p
|
||||||
|
|
||||||
clearCurrentLine :: IO ()
|
clearCurrentLine :: IO ()
|
||||||
clearCurrentLine = do
|
clearCurrentLine = do
|
||||||
width <- getAvailableWidth
|
width <- getAvailableWidth
|
||||||
putStr "\r"
|
putStr "\r"
|
||||||
putStr . replicate width $ ' '
|
putStr $ replicate (P.widthToInt width) ' '
|
||||||
putStr "\r"
|
putStr "\r"
|
||||||
|
|
||||||
putPretty' :: P.Pretty CT.ColorText -> IO ()
|
putPretty' :: P.Pretty CT.ColorText -> IO ()
|
||||||
putPretty' p = do
|
putPretty' p = do
|
||||||
width <- getAvailableWidth
|
width <- getAvailableWidth
|
||||||
putStr . P.toANSI width $ p
|
putStr $ P.toANSI width p
|
||||||
|
|
||||||
getAvailableWidth :: IO Int
|
getAvailableWidth :: IO P.Width
|
||||||
getAvailableWidth =
|
getAvailableWidth =
|
||||||
maybe 80 (\s -> 100 `min` Terminal.width s) <$> Terminal.size
|
maybe 80 (\s -> 100 `min` P.Width (Terminal.width s)) <$> Terminal.size
|
||||||
|
|
||||||
putPrettyNonempty :: P.Pretty P.ColorText -> IO ()
|
putPrettyNonempty :: P.Pretty P.ColorText -> IO ()
|
||||||
putPrettyNonempty msg = do
|
putPrettyNonempty msg = do
|
||||||
|
@ -245,7 +245,7 @@ typeListEntry codebase r n = do
|
|||||||
pure $ TypeEntry r n tag
|
pure $ TypeEntry r n tag
|
||||||
|
|
||||||
termEntryToNamedTerm
|
termEntryToNamedTerm
|
||||||
:: Var v => PPE.PrettyPrintEnv -> Maybe Int -> TermEntry v a -> NamedTerm
|
:: Var v => PPE.PrettyPrintEnv -> Maybe Width -> TermEntry v a -> NamedTerm
|
||||||
termEntryToNamedTerm ppe typeWidth (TermEntry r name mayType tag) = NamedTerm
|
termEntryToNamedTerm ppe typeWidth (TermEntry r name mayType tag) = NamedTerm
|
||||||
{ termName = HQ'.toText name
|
{ termName = HQ'.toText name
|
||||||
, termHash = Referent.toText r
|
, termHash = Referent.toText r
|
||||||
@ -660,7 +660,7 @@ definitionsBySuffixes relativeTo branch codebase query = do
|
|||||||
termsToSyntax
|
termsToSyntax
|
||||||
:: Var v
|
:: Var v
|
||||||
=> Ord a
|
=> Ord a
|
||||||
=> Int
|
=> Width
|
||||||
-> PPE.PrettyPrintEnvDecl
|
-> PPE.PrettyPrintEnvDecl
|
||||||
-> Map Reference.Reference (DisplayObject (Term v a))
|
-> Map Reference.Reference (DisplayObject (Term v a))
|
||||||
-> Map Reference.Reference (DisplayObject SyntaxText)
|
-> Map Reference.Reference (DisplayObject SyntaxText)
|
||||||
@ -677,7 +677,7 @@ termsToSyntax width ppe0 terms =
|
|||||||
typesToSyntax
|
typesToSyntax
|
||||||
:: Var v
|
:: Var v
|
||||||
=> Ord a
|
=> Ord a
|
||||||
=> Int
|
=> Width
|
||||||
-> PPE.PrettyPrintEnvDecl
|
-> PPE.PrettyPrintEnvDecl
|
||||||
-> Map Reference.Reference (DisplayObject (DD.Decl v a))
|
-> Map Reference.Reference (DisplayObject (DD.Decl v a))
|
||||||
-> Map Reference.Reference (DisplayObject SyntaxText)
|
-> Map Reference.Reference (DisplayObject SyntaxText)
|
||||||
|
@ -57,8 +57,8 @@ import Unison.NameSegment
|
|||||||
type FuzzyFindAPI =
|
type FuzzyFindAPI =
|
||||||
"find" :> QueryParam "rootBranch" SBH.ShortBranchHash
|
"find" :> QueryParam "rootBranch" SBH.ShortBranchHash
|
||||||
:> QueryParam "relativeTo" HashQualifiedName
|
:> QueryParam "relativeTo" HashQualifiedName
|
||||||
:> QueryParam "renderWidth" Width
|
|
||||||
:> QueryParam "limit" Int
|
:> QueryParam "limit" Int
|
||||||
|
:> QueryParam "renderWidth" Width
|
||||||
:> QueryParam "query" String
|
:> QueryParam "query" String
|
||||||
:> Get '[JSON] [(FZF.Alignment, FoundResult)]
|
:> Get '[JSON] [(FZF.Alignment, FoundResult)]
|
||||||
|
|
||||||
|
@ -23,7 +23,7 @@ import Unison.Name ( Name )
|
|||||||
import Unison.ShortHash ( ShortHash )
|
import Unison.ShortHash ( ShortHash )
|
||||||
import Unison.Codebase.ShortBranchHash
|
import Unison.Codebase.ShortBranchHash
|
||||||
( ShortBranchHash(..) )
|
( ShortBranchHash(..) )
|
||||||
import Unison.Util.Pretty ( Width
|
import Unison.Util.Pretty ( Width(..)
|
||||||
, render
|
, render
|
||||||
)
|
)
|
||||||
import Unison.Var ( Var )
|
import Unison.Var ( Var )
|
||||||
@ -50,6 +50,9 @@ deriving instance ToSchema Name
|
|||||||
deriving via Text instance FromHttpApiData ShortBranchHash
|
deriving via Text instance FromHttpApiData ShortBranchHash
|
||||||
deriving instance ToParamSchema ShortBranchHash
|
deriving instance ToParamSchema ShortBranchHash
|
||||||
|
|
||||||
|
deriving via Int instance FromHttpApiData Width
|
||||||
|
deriving instance ToParamSchema Width
|
||||||
|
|
||||||
instance ToJSON a => ToJSON (DisplayObject a) where
|
instance ToJSON a => ToJSON (DisplayObject a) where
|
||||||
toEncoding = genericToEncoding defaultOptions
|
toEncoding = genericToEncoding defaultOptions
|
||||||
deriving instance ToSchema a => ToSchema (DisplayObject a)
|
deriving instance ToSchema a => ToSchema (DisplayObject a)
|
||||||
|
@ -39,7 +39,7 @@ import qualified Unison.Var as Var
|
|||||||
import qualified Unison.Util.Bytes as Bytes
|
import qualified Unison.Util.Bytes as Bytes
|
||||||
import Unison.Util.Monoid ( intercalateMap )
|
import Unison.Util.Monoid ( intercalateMap )
|
||||||
import qualified Unison.Util.Pretty as PP
|
import qualified Unison.Util.Pretty as PP
|
||||||
import Unison.Util.Pretty ( Pretty, ColorText )
|
import Unison.Util.Pretty ( Pretty, ColorText, Width )
|
||||||
import Unison.PrettyPrintEnv ( PrettyPrintEnv, Suffix, Prefix, Imports, elideFQN )
|
import Unison.PrettyPrintEnv ( PrettyPrintEnv, Suffix, Prefix, Imports, elideFQN )
|
||||||
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
||||||
import qualified Unison.Builtin.Decls as DD
|
import qualified Unison.Builtin.Decls as DD
|
||||||
@ -49,7 +49,7 @@ import qualified Unison.ConstructorType as CT
|
|||||||
pretty :: Var v => PrettyPrintEnv -> Term v a -> Pretty ColorText
|
pretty :: Var v => PrettyPrintEnv -> Term v a -> Pretty ColorText
|
||||||
pretty env = PP.syntaxToColor . pretty0 env emptyAc . printAnnotate env
|
pretty env = PP.syntaxToColor . pretty0 env emptyAc . printAnnotate env
|
||||||
|
|
||||||
pretty' :: Var v => Maybe Int -> PrettyPrintEnv -> Term v a -> ColorText
|
pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Term v a -> ColorText
|
||||||
pretty' (Just width) n t =
|
pretty' (Just width) n t =
|
||||||
PP.render width $ PP.syntaxToColor $ pretty0 n emptyAc (printAnnotate n t)
|
PP.render width $ PP.syntaxToColor $ pretty0 n emptyAc (printAnnotate n t)
|
||||||
pretty' Nothing n t =
|
pretty' Nothing n t =
|
||||||
@ -525,7 +525,7 @@ prettyBinding n = prettyBinding0 n $ ac (-1) Block Map.empty MaybeDoc
|
|||||||
|
|
||||||
prettyBinding'
|
prettyBinding'
|
||||||
:: Var v
|
:: Var v
|
||||||
=> Int
|
=> Width
|
||||||
-> PrettyPrintEnv
|
-> PrettyPrintEnv
|
||||||
-> HQ.HashQualified Name
|
-> HQ.HashQualified Name
|
||||||
-> Term v a
|
-> Term v a
|
||||||
|
@ -13,7 +13,7 @@ import Unison.PrettyPrintEnv (PrettyPrintEnv, Imports, elideFQN)
|
|||||||
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
import qualified Unison.PrettyPrintEnv as PrettyPrintEnv
|
||||||
import Unison.Reference (pattern Builtin)
|
import Unison.Reference (pattern Builtin)
|
||||||
import Unison.Type
|
import Unison.Type
|
||||||
import Unison.Util.Pretty (ColorText, Pretty)
|
import Unison.Util.Pretty (ColorText, Pretty, Width)
|
||||||
import Unison.Util.ColorText (toPlain)
|
import Unison.Util.ColorText (toPlain)
|
||||||
import qualified Unison.Util.SyntaxText as S
|
import qualified Unison.Util.SyntaxText as S
|
||||||
import Unison.Util.SyntaxText (SyntaxText)
|
import Unison.Util.SyntaxText (SyntaxText)
|
||||||
@ -25,9 +25,11 @@ import qualified Unison.Builtin.Decls as DD
|
|||||||
pretty :: forall v a . (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
|
pretty :: forall v a . (Var v) => PrettyPrintEnv -> Type v a -> Pretty ColorText
|
||||||
pretty ppe = PP.syntaxToColor . pretty0 ppe mempty (-1)
|
pretty ppe = PP.syntaxToColor . pretty0 ppe mempty (-1)
|
||||||
|
|
||||||
pretty' :: Var v => Maybe Int -> PrettyPrintEnv -> Type v a -> String
|
pretty' :: Var v => Maybe Width -> PrettyPrintEnv -> Type v a -> String
|
||||||
pretty' (Just width) n t = toPlain $ PP.render width $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
pretty' (Just width) n t =
|
||||||
pretty' Nothing n t = toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
toPlain $ PP.render width $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||||
|
pretty' Nothing n t =
|
||||||
|
toPlain $ PP.render maxBound $ PP.syntaxToColor $ pretty0 n Map.empty (-1) t
|
||||||
|
|
||||||
{- Explanation of precedence handling
|
{- Explanation of precedence handling
|
||||||
|
|
||||||
|
@ -1,3 +1,5 @@
|
|||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE DeriveTraversable #-}
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
@ -101,7 +103,7 @@ module Unison.Util.Pretty (
|
|||||||
wrapString,
|
wrapString,
|
||||||
black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
|
black, red, green, yellow, blue, purple, cyan, white, hiBlack, hiRed, hiGreen, hiYellow, hiBlue, hiPurple, hiCyan, hiWhite, bold,
|
||||||
border,
|
border,
|
||||||
Width,
|
Width(..),
|
||||||
-- * Exported for testing
|
-- * Exported for testing
|
||||||
delta,
|
delta,
|
||||||
Delta,
|
Delta,
|
||||||
@ -122,7 +124,9 @@ import qualified Data.Sequence as Seq
|
|||||||
import qualified Data.Text as Text
|
import qualified Data.Text as Text
|
||||||
import Control.Monad.Identity (runIdentity, Identity(..))
|
import Control.Monad.Identity (runIdentity, Identity(..))
|
||||||
|
|
||||||
type Width = Int
|
newtype Width = Width {widthToInt :: Int}
|
||||||
|
deriving (Eq, Ord, Show, Generic, Num, Bounded)
|
||||||
|
|
||||||
type ColorText = CT.ColorText
|
type ColorText = CT.ColorText
|
||||||
|
|
||||||
data Pretty s = Pretty { delta :: Delta, out :: F s (Pretty s) } deriving Eq
|
data Pretty s = Pretty { delta :: Delta, out :: F s (Pretty s) } deriving Eq
|
||||||
@ -382,7 +386,7 @@ surroundCommas start stop fs =
|
|||||||
<> spaceIfBreak
|
<> spaceIfBreak
|
||||||
<> intercalateMap ("," <> softbreak <> align) id fs
|
<> intercalateMap ("," <> softbreak <> align) id fs
|
||||||
<> stop
|
<> stop
|
||||||
where align = spacesIfBreak (preferredWidth start + 1)
|
where align = spacesIfBreak (widthToInt $ preferredWidth start + 1)
|
||||||
|
|
||||||
sepSpaced :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
|
sepSpaced :: (Foldable f, IsString s) => Pretty s -> f (Pretty s) -> Pretty s
|
||||||
sepSpaced between = sep (between <> softbreak)
|
sepSpaced between = sep (between <> softbreak)
|
||||||
@ -487,13 +491,13 @@ numberedColumn2Header num ps = numberedHeader (maybe mempty num) (align $ toList
|
|||||||
numberedList :: Foldable f => f (Pretty ColorText) -> Pretty ColorText
|
numberedList :: Foldable f => f (Pretty ColorText) -> Pretty ColorText
|
||||||
numberedList = numbered (\i -> hiBlack . fromString $ show i <> ".")
|
numberedList = numbered (\i -> hiBlack . fromString $ show i <> ".")
|
||||||
|
|
||||||
leftPad, rightPad :: IsString s => Int -> Pretty s -> Pretty s
|
leftPad, rightPad :: IsString s => Width -> Pretty s -> Pretty s
|
||||||
leftPad n p =
|
leftPad n p =
|
||||||
let rem = n - preferredWidth p
|
let rem = n - preferredWidth p
|
||||||
in if rem > 0 then fromString (replicate rem ' ') <> p else p
|
in if rem > 0 then fromString (replicate (widthToInt rem) ' ') <> p else p
|
||||||
rightPad n p =
|
rightPad n p =
|
||||||
let rem = n - preferredWidth p
|
let rem = n - preferredWidth p
|
||||||
in if rem > 0 then p <> fromString (replicate rem ' ') else p
|
in if rem > 0 then p <> fromString (replicate (widthToInt rem) ' ') else p
|
||||||
|
|
||||||
excerptColumn2Headed
|
excerptColumn2Headed
|
||||||
:: (LL.ListLike s Char, IsString s)
|
:: (LL.ListLike s Char, IsString s)
|
||||||
@ -589,12 +593,14 @@ column3sep sep rows = let
|
|||||||
abc = group <$> align [(a,sep <> bc) | ((a,_,_),bc) <- rows `zip` bc ]
|
abc = group <$> align [(a,sep <> bc) | ((a,_,_),bc) <- rows `zip` bc ]
|
||||||
in lines abc
|
in lines abc
|
||||||
|
|
||||||
wrapColumn2 ::
|
wrapColumn2
|
||||||
(LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> Pretty s
|
||||||
wrapColumn2 rows = lines (align rows) where
|
wrapColumn2 rows = lines (align rows) where
|
||||||
align rows = let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 2
|
align rows =
|
||||||
in [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
|
let lwidth = foldl' max 0 (preferredWidth . fst <$> rows) + 2
|
||||||
| (l, r) <- rows]
|
in [ group (rightPad lwidth l <> indentNAfterNewline lwidth (wrap r))
|
||||||
|
| (l, r) <- rows
|
||||||
|
]
|
||||||
|
|
||||||
align
|
align
|
||||||
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> [Pretty s]
|
:: (LL.ListLike s Char, IsString s) => [(Pretty s, Pretty s)] -> [Pretty s]
|
||||||
@ -622,8 +628,7 @@ align' rows = alignedRows
|
|||||||
col0Width = foldl' max 0 [ preferredWidth col1 | (col1, Just _) <- rows ] + 1
|
col0Width = foldl' max 0 [ preferredWidth col1 | (col1, Just _) <- rows ] + 1
|
||||||
alignedRows =
|
alignedRows =
|
||||||
[ case col1 of
|
[ case col1 of
|
||||||
Just s ->
|
Just s -> (rightPad col0Width col0, indentNAfterNewline col0Width s)
|
||||||
(rightPad col0Width col0, indentNAfterNewline col0Width s)
|
|
||||||
Nothing -> (col0, mempty)
|
Nothing -> (col0, mempty)
|
||||||
| (col0, col1) <- rows
|
| (col0, col1) <- rows
|
||||||
]
|
]
|
||||||
@ -674,15 +679,17 @@ indent :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
|||||||
indent by p = by <> indentAfterNewline by p
|
indent by p = by <> indentAfterNewline by p
|
||||||
|
|
||||||
indentN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
indentN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||||
indentN by = indent (fromString $ replicate by ' ')
|
indentN by = indent (fromString $ replicate (widthToInt by) ' ')
|
||||||
|
|
||||||
indentNonEmptyN :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
indentNonEmptyN
|
||||||
indentNonEmptyN _ (out -> Empty) = mempty
|
:: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||||
indentNonEmptyN by p = indentN by p
|
indentNonEmptyN _ (out -> Empty) = mempty
|
||||||
|
indentNonEmptyN by p = indentN by p
|
||||||
|
|
||||||
indentNAfterNewline
|
indentNAfterNewline
|
||||||
:: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
:: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||||
indentNAfterNewline by = indentAfterNewline (fromString $ replicate by ' ')
|
indentNAfterNewline by =
|
||||||
|
indentAfterNewline (fromString $ replicate (widthToInt by) ' ')
|
||||||
|
|
||||||
indentAfterNewline
|
indentAfterNewline
|
||||||
:: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
:: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
||||||
@ -784,7 +791,7 @@ plural f p = case length f of
|
|||||||
's' : _ -> "es"
|
's' : _ -> "es"
|
||||||
_ -> "s"
|
_ -> "s"
|
||||||
|
|
||||||
border :: (LL.ListLike s Char, IsString s) => Int -> Pretty s -> Pretty s
|
border :: (LL.ListLike s Char, IsString s) => Width -> Pretty s -> Pretty s
|
||||||
border n p = "\n" <> indentN n p <> "\n"
|
border n p = "\n" <> indentN n p <> "\n"
|
||||||
|
|
||||||
callout :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
callout :: (LL.ListLike s Char, IsString s) => Pretty s -> Pretty s -> Pretty s
|
||||||
|
Loading…
Reference in New Issue
Block a user