-- * Class 'Doc_Text'
class (IsString d, Semigroup d) => Doc_Text d where
- charH :: Char -> d -- ^ XXX: MUST NOT be '\n'
- stringH :: String -> d -- ^ XXX: MUST NOT contain '\n'
- textH :: Text -> d -- ^ XXX: MUST NOT contain '\n'
- ltextH :: TL.Text -> d -- ^ XXX: MUST NOT contain '\n'
+ charH :: Char -- ^ XXX: MUST NOT be '\n'
+ -> d
+ stringH :: String -- ^ XXX: MUST NOT contain '\n'
+ -> d
+ textH :: Text -- ^ XXX: MUST NOT contain '\n'
+ -> d
+ ltextH :: TL.Text -- ^ XXX: MUST NOT contain '\n'
+ -> d
replicate :: Int -> d -> d
integer :: Integer -> d
default replicate :: Doc_Text (ReprOf d) => Trans d => Int -> d -> d
empty :: d
newline :: d
space :: d
+ -- | @x '<+>' y = x '<>' 'space' '<>' y@
(<+>) :: d -> d -> d
+ -- | @x '</>' y = x '<>' 'newline' '<>' y@
+ (</>) :: d -> d -> d
int :: Int -> d
char :: Char -> d
string :: String -> d
newline = "\n"
space = char ' '
x <+> y = x <> space <> y
+ x </> y = x <> newline <> y
int = integer . toInteger
char = \case '\n' -> newline; c -> charH c
string = catV . fmap stringH . L.lines
catH = foldr (<>) empty
catV = foldrWith (\x y -> x<>newline<>y)
foldrWith f ds = if null ds then empty else foldr1 f ds
- foldWith f = foldrWith (\a acc -> a <> f acc)
+ foldWith f = foldrWith $ \a acc -> a <> f acc
intercalate sep = foldrWith (\x y -> x<>sep<>y)
between o c d = o<>d<>c
-- default catH :: Doc_Text (ReprOf d) => Trans d => Foldable f => Functor f => f d -> d
type Column d = Int
type Indent d
type Indent d = Int
- -- | @align d@, make @d@ uses current 'Column' as 'Indent' level.
+ -- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
align :: d -> d
- -- | @hang ind d@, make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
+ -- | @('hang' ind d)@ make @d@ uses current 'Column' plus @ind@ as 'Indent' level.
hang :: Indent d -> d -> d
hang ind = align . incrIndent ind
- -- | @incrIndent ind d@, make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
+ -- | @('incrIndent' ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
incrIndent :: Indent d -> d -> d
- -- | @withIndent ind d@, make @d@ uses @ind@ as 'Indent' level.
+ -- | @('withIndent' ind d)@ make @d@ uses @ind@ as 'Indent' level.
withIndent :: Indent d -> d -> d
- -- | @withNewline nl d@, make @d@ uses @nl@ as 'newline'.
+ -- | @('withNewline' nl d)@ make @d@ uses @nl@ as 'newline'.
withNewline :: d -> d -> d
- -- | @column f@, return @f@ applied to the current 'Column'.
+ -- | @('column' f)@ returns @f@ applied to the current 'Column'.
column :: (Column d -> d) -> d
- -- | @endToEndWidth d f@, return @d@ concatenated to
+ -- | @('endToEndWidth' d f)@ returns @d@ concatenated to
-- @f@ applied to the difference between the end 'Column' and start 'Column' of @d@.
--
-- Note that @f@ is given the end-to-end width,
endToEndWidth :: d -> (Column d -> d) -> d
endToEndWidth d f = column $ \c1 -> (d <>) $ column $ \c2 -> f $ c2 - c1
- -- | @spaces ind@, replicates 'space' @ind@ times.
+ -- | @'spaces' ind = 'replicate' ind 'space'@
default spaces :: Indent d ~ Int => Indent d -> d
spaces :: Indent d -> d
spaces i = replicate i space
+ -- | @('fill' ind d)@ returns @d@ then as many 'space's as needed
+ -- so that the whole is @ind@ 'Column's wide.
default fill ::
Indent d ~ Int =>
Column d ~ Int =>
LT -> spaces $ m - w
_ -> empty
+ -- | @('breakableFill' ind f d)@ returns @f@ then as many 'space's as needed
+ -- so that the whole is @ind@ 'Column's wide,
+ -- then, if @f@ is not wider than @ind@, appends @d@,
+ -- otherwise appends a 'newline' and @d@,
+ -- with an 'Indent' level set to the start 'Column' of @f@ plus @ind@.
default breakableFill ::
Indent d ~ Int =>
Column d ~ Int =>
- Indent d -> d -> d
- breakableFill :: Indent d -> d -> d
- breakableFill m d =
- endToEndWidth d $ \w ->
+ Indent d -> d -> d -> d
+ breakableFill :: Indent d -> d -> d -> d
+ breakableFill m f d =
+ column $ \c ->
+ endToEndWidth f $ \w ->
case w`compare`m of
- LT -> spaces $ m - w
- EQ -> empty
- GT -> incrIndent m newline
+ LT -> spaces (m - w) <> d
+ EQ -> d
+ GT -> withIndent (c + m) (newline <> d)
-- * Class 'Doc_Wrap'
class (Doc_Text d, Doc_Align d) => Doc_Wrap d where
- -- | @ifFit onFit onNoFit@,
+ -- | @('ifFit' onFit onNoFit)@
-- return @onFit@ if @onFit@ leads to a 'Column'
-- lower or equal to the one sets with 'withWrapColumn',
-- otherwise return @onNoFit@.
ifFit :: d -> d -> d
- -- | @breakpoint onNoBreak onBreak d@,
+ -- | @('breakpoint' onNoBreak onBreak d)@
-- return @onNoBreak@ then @d@ if they fit,
-- @onBreak@ otherwise.
breakpoint :: d -> d -> d -> d
- -- | @breakableEmpty d@, return @d@ if it fits, 'newline' then @d@ otherwise.
+ -- | @('breakableEmpty' d)@ returns @d@ if it fits, 'newline' then @d@ otherwise.
breakableEmpty :: d -> d
breakableEmpty = breakpoint empty newline
- -- | @breakableSpace d@, return 'space' then @d@ it they fit, 'newline' then @d@ otherwise.
+ -- | @x '><' y = x '<>' 'breakableEmpty' y@
+ (><) :: d -> d -> d
+ x >< y = x <> breakableEmpty y
+ -- | @('breakableSpace' d)@ returns 'space' then @d@ it they fit,
+ -- 'newline' then @d@ otherwise.
breakableSpace :: d -> d
breakableSpace = breakpoint space newline
- -- | @breakableSpaces ds@ intercalate a 'breakableSpace' between items of @ds@.
+ -- | @x '>+<' y = x '<>' 'breakableSpace' y@
+ (>+<) :: d -> d -> d
+ x >+< y = x <> breakableSpace y
+ -- | @'breakableSpaces' ds@ intercalate a 'breakableSpace'
+ -- between items of @ds@.
breakableSpaces :: Foldable f => f d -> d
breakableSpaces = foldWith breakableSpace
- -- | @withWrapColumn col d@ set the 'Column' triggering wrapping to @col@ within @d@.
+ -- | @'withWrapColumn' col d@ set the 'Column' triggering wrapping to @col@ within @d@.
withWrapColumn :: Column d -> d -> d
- -- | @intercalateHorV sep ds@,
+ -- | @('intercalateHorV' sep ds)@
-- return @ds@ with @sep@ intercalated if the whole fits,
-- otherwise return 'align' of @ds@ with 'newline' and @sep@ intercalated.
intercalateHorV :: Foldable f => d -> f d -> d
intercalateHorV sep xs =
- ifFit (foldr1 (\a acc -> a <> sep <> acc) xs)
- (align $ foldr1 (\a acc -> a <> newline <> sep <> acc) xs)
+ ifFit (foldWith (sep <>) xs)
+ (align $ foldWith ((newline <> sep) <>) xs)
-- * Class 'Doc_Color'
class Doc_Color d where
sourcephile / git / haskell / symantic.git / commitdiff