packages feed

char-boxdrawing (empty) → 1

raw patch · 3 files changed

+822/−0 lines, 3 filesdep +base

Dependencies added: base

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2024, Mike Ledger++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mike Ledger nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ char-boxdrawing.cabal view
@@ -0,0 +1,20 @@+cabal-version: 2.0+name:          char-boxdrawing+version:       1+synopsis:      Combinators for unicode or ASCII box drawing characters+description:+  Draw and intersect border characters for text-based drawings++license:       BSD3+license-file:  LICENSE+author:        Mike Ledger+maintainer:    mike@quasimal.com+copyright:     2024+category:      Text+build-type:    Simple++library+  exposed-modules:  Data.Char.BoxDrawing+  build-depends:    base >=4.17 && <5+  hs-source-dirs:   src+  default-language: Haskell2010
+ src/Data/Char/BoxDrawing.hs view
@@ -0,0 +1,772 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Data.Char.BoxDrawing (+  -- * Box border type+  Drawing,+  render,+  lookup,+  read,+  overlay,++  -- ** Box drawing styles+  BoxDrawingStyle,+  ascii,+  unicode,++  -- * Drawings++  -- ** Base primitives+  -- $primitives+  up,+  down,+  left,+  right,++  -- ** Combinations+  -- $combinations+  horizontal,+  vertical,+  cornerTL,+  cornerTR,+  cornerBR,+  cornerBL,+  intersectFull,+  intersectL,+  intersectR,+  intersectT,+  intersectB,++  -- ** Box drawing modifiers+  -- $modifiers+  heavy,+  heavyHoriz,+  heavyVert,+  dashed2,+  dashed3,+  double,+  doubleHoriz,+  doubleVert,+  rounded,+) where++import Data.Bits+import Data.Coerce+import Data.Maybe (fromMaybe)+import Data.Word (Word8)+import Text.Printf (printf)+import Prelude hiding (lookup, read)++--------------------------------------------------------------------------------+--++-- $primitives+--+-- Use the 'Semigroup' instance to combine box 'Drawing'.++up, left, right, down, cornerTL, cornerTR, cornerBR, cornerBL, horizontal, vertical, intersectL, intersectR, intersectT, intersectB, intersectFull :: Drawing+up = bb BUp+left = bb BLeft+right = bb BRight+down = bb BDown++-- $combinations+--+-- These are pre-made combinations of 'up', 'down', 'left', and 'right'.++cornerTL = bb BDown <> bb BRight+cornerTR = bb BDown <> bb BLeft+cornerBR = bb BUp <> bb BLeft+cornerBL = bb BUp <> bb BRight+horizontal = bb BLeft <> bb BRight+vertical = bb BUp <> bb BDown+intersectL = vertical <> right+intersectR = vertical <> left+intersectT = horizontal <> down+intersectB = horizontal <> up+intersectFull = horizontal <> vertical++-- $modifiers+--+-- Combine these using the 'Semigroup' instance with another 'Drawing' to set+-- its style, such as heavy, dashed, etc. - only relevant for the style+-- 'unicode' and has no effect for the style 'ascii'.++double, doubleHoriz, doubleVert, heavy, dashed2, dashed3, dashed4, rounded, heavyHoriz, heavyVert :: Drawing+double = style1 Double+doubleHoriz = style1 DoubleHoriz+doubleVert = style1 DoubleVert+heavy = style1 Heavy+heavyHoriz = style1 HeavyHoriz+heavyVert = style1 HeavyVert+dashed2 = style1 Dashed2+dashed3 = style1 Dashed3+dashed4 = style1 Dashed4+rounded = style1 Rounded++bb :: Drawing1 -> Drawing+bb = boxBorderBits++--------------------------------------------------------------------------------++-- | A border style such as ASCII or unicode. Describes how to turn a+-- 'Drawing' into an actual character for rendering, or to lookup a character+-- from a buffer into a 'Drawing' for combining different border characters+data BoxDrawingStyle = BoxDrawingStyle+  { render :: Drawing -> Char+  -- ^ Render a 'Drawing' given the style+  , lookup :: Char -> Maybe Drawing+  -- ^ Lookup a character given the style+  }++--------------------------------------------------------------------------------+-- Generated code by using TH and then copy-pasting it back with -ddump-splices+--+-- Hopefully, there are no bugs in this ever :)+--++-- | A basic box-drawing style that uses @|@, @+@, and @-@+ascii :: BoxDrawingStyle+ascii =+  ( \(run :: Word8 -> Char)+     (runBack :: Char -> Maybe Word8) ->+        BoxDrawingStyle (coerce run) (coerce runBack)+  )+    ( \case+        3 -> '|'+        5 -> '+'+        6 -> '+'+        7 -> '+'+        9 -> '+'+        10 -> '+'+        11 -> '+'+        12 -> '-'+        13 -> '+'+        14 -> '+'+        15 -> '+'+        19 -> '|'+        21 -> '+'+        22 -> '+'+        23 -> '+'+        25 -> '+'+        26 -> '+'+        27 -> '+'+        28 -> '-'+        29 -> '+'+        30 -> '+'+        31 -> '+'+        35 -> '|'+        37 -> '+'+        38 -> '+'+        39 -> '+'+        41 -> '+'+        42 -> '+'+        43 -> '+'+        44 -> '-'+        45 -> '+'+        46 -> '+'+        47 -> '+'+        51 -> '|'+        53 -> '+'+        54 -> '+'+        55 -> '+'+        57 -> '+'+        58 -> '+'+        59 -> '+'+        60 -> '-'+        61 -> '+'+        62 -> '+'+        63 -> '+'+        67 -> '|'+        69 -> '+'+        70 -> '+'+        71 -> '+'+        73 -> '+'+        74 -> '+'+        75 -> '+'+        76 -> '-'+        77 -> '+'+        78 -> '+'+        79 -> '+'+        83 -> '|'+        85 -> '+'+        86 -> '+'+        87 -> '+'+        89 -> '+'+        90 -> '+'+        91 -> '+'+        92 -> '-'+        93 -> '+'+        94 -> '+'+        95 -> '+'+        99 -> '|'+        101 -> '+'+        102 -> '+'+        103 -> '+'+        105 -> '+'+        106 -> '+'+        107 -> '+'+        108 -> '-'+        109 -> '+'+        110 -> '+'+        111 -> '+'+        115 -> '|'+        117 -> '+'+        118 -> '+'+        119 -> '+'+        121 -> '+'+        122 -> '+'+        123 -> '+'+        124 -> '-'+        125 -> '+'+        126 -> '+'+        127 -> '+'+        131 -> '|'+        133 -> '+'+        134 -> '+'+        135 -> '+'+        137 -> '+'+        138 -> '+'+        139 -> '+'+        140 -> '-'+        141 -> '+'+        142 -> '+'+        143 -> '+'+        147 -> '|'+        149 -> '+'+        150 -> '+'+        151 -> '+'+        153 -> '+'+        154 -> '+'+        155 -> '+'+        156 -> '-'+        157 -> '+'+        158 -> '+'+        159 -> '+'+        163 -> '|'+        165 -> '+'+        166 -> '+'+        167 -> '+'+        169 -> '+'+        170 -> '+'+        171 -> '+'+        172 -> '-'+        173 -> '+'+        174 -> '+'+        175 -> '+'+        179 -> '|'+        181 -> '+'+        182 -> '+'+        183 -> '+'+        185 -> '+'+        186 -> '+'+        187 -> '+'+        188 -> '-'+        189 -> '+'+        190 -> '+'+        191 -> '+'+        195 -> '|'+        197 -> '+'+        198 -> '+'+        199 -> '+'+        201 -> '+'+        202 -> '+'+        203 -> '+'+        204 -> '-'+        205 -> '+'+        206 -> '+'+        207 -> '+'+        211 -> '|'+        213 -> '+'+        214 -> '+'+        215 -> '+'+        217 -> '+'+        218 -> '+'+        219 -> '+'+        220 -> '-'+        221 -> '+'+        222 -> '+'+        223 -> '+'+        227 -> '|'+        229 -> '+'+        230 -> '+'+        231 -> '+'+        233 -> '+'+        234 -> '+'+        235 -> '+'+        236 -> '-'+        237 -> '+'+        238 -> '+'+        239 -> '+'+        243 -> '|'+        245 -> '+'+        246 -> '+'+        247 -> '+'+        249 -> '+'+        250 -> '+'+        251 -> '+'+        252 -> '-'+        253 -> '+'+        254 -> '+'+        255 -> '+'+        _ -> ' '+    )+    ( \case+        '+' -> Just 255+        '-' -> Just 252+        '|' -> Just 243+        _ -> Nothing+    )++-- | An advanced box-drawing style that supports all the drawing primitives+-- provided in this module+unicode :: BoxDrawingStyle+unicode =+  ( \(run :: Word8 -> Char)+     (runBack :: Char -> Maybe Word8) ->+        BoxDrawingStyle (coerce run) (coerce runBack)+  )+    ( \case+        1 -> '\9589'+        2 -> '\9591'+        3 -> '\9474'+        4 -> '\9588'+        5 -> '\9496'+        6 -> '\9488'+        7 -> '\9508'+        8 -> '\9590'+        9 -> '\9492'+        10 -> '\9484'+        11 -> '\9500'+        12 -> '\9472'+        13 -> '\9524'+        14 -> '\9516'+        15 -> '\9532'+        17 -> '\9589'+        18 -> '\9591'+        19 -> '\9474'+        20 -> '\9588'+        21 -> '\9583'+        22 -> '\9582'+        23 -> '\9508'+        24 -> '\9590'+        25 -> '\9584'+        26 -> '\9581'+        27 -> '\9500'+        28 -> '\9472'+        29 -> '\9524'+        30 -> '\9516'+        31 -> '\9532'+        33 -> '\9589'+        34 -> '\9591'+        35 -> '\9550'+        36 -> '\9588'+        37 -> '\9496'+        38 -> '\9488'+        39 -> '\9508'+        40 -> '\9590'+        41 -> '\9492'+        42 -> '\9484'+        43 -> '\9500'+        44 -> '\9548'+        45 -> '\9524'+        46 -> '\9516'+        47 -> '\9532'+        49 -> '\9589'+        50 -> '\9591'+        51 -> '\9474'+        52 -> '\9588'+        53 -> '\9496'+        54 -> '\9488'+        55 -> '\9508'+        56 -> '\9590'+        57 -> '\9492'+        58 -> '\9484'+        59 -> '\9500'+        60 -> '\9472'+        61 -> '\9524'+        62 -> '\9516'+        63 -> '\9532'+        65 -> '\9589'+        66 -> '\9591'+        67 -> '\9478'+        68 -> '\9588'+        69 -> '\9496'+        70 -> '\9488'+        71 -> '\9508'+        72 -> '\9590'+        73 -> '\9492'+        74 -> '\9484'+        75 -> '\9500'+        76 -> '\9476'+        77 -> '\9524'+        78 -> '\9516'+        79 -> '\9532'+        81 -> '\9589'+        82 -> '\9591'+        83 -> '\9474'+        84 -> '\9588'+        85 -> '\9496'+        86 -> '\9488'+        87 -> '\9508'+        88 -> '\9590'+        89 -> '\9492'+        90 -> '\9484'+        91 -> '\9500'+        92 -> '\9472'+        93 -> '\9524'+        94 -> '\9516'+        95 -> '\9532'+        97 -> '\9589'+        98 -> '\9591'+        99 -> '\9482'+        100 -> '\9588'+        101 -> '\9496'+        102 -> '\9488'+        103 -> '\9508'+        104 -> '\9590'+        105 -> '\9492'+        106 -> '\9484'+        107 -> '\9500'+        108 -> '\9480'+        109 -> '\9524'+        110 -> '\9516'+        111 -> '\9532'+        113 -> '\9589'+        114 -> '\9591'+        115 -> '\9474'+        116 -> '\9588'+        117 -> '\9496'+        118 -> '\9488'+        119 -> '\9508'+        120 -> '\9590'+        121 -> '\9492'+        122 -> '\9484'+        123 -> '\9500'+        124 -> '\9472'+        125 -> '\9524'+        126 -> '\9516'+        127 -> '\9532'+        129 -> '\9589'+        130 -> '\9591'+        131 -> '\9474'+        132 -> '\9588'+        133 -> '\9497'+        134 -> '\9489'+        135 -> '\9509'+        136 -> '\9590'+        137 -> '\9493'+        138 -> '\9485'+        139 -> '\9501'+        140 -> '\9473'+        141 -> '\9527'+        142 -> '\9519'+        143 -> '\9535'+        145 -> '\9589'+        146 -> '\9591'+        147 -> '\9475'+        148 -> '\9588'+        149 -> '\9498'+        150 -> '\9490'+        151 -> '\9512'+        152 -> '\9590'+        153 -> '\9493'+        154 -> '\9486'+        155 -> '\9504'+        156 -> '\9472'+        157 -> '\9528'+        158 -> '\9520'+        159 -> '\9538'+        161 -> '\9593'+        162 -> '\9595'+        163 -> '\9475'+        164 -> '\9592'+        165 -> '\9499'+        166 -> '\9491'+        167 -> '\9515'+        168 -> '\9594'+        169 -> '\9495'+        170 -> '\9487'+        171 -> '\9507'+        172 -> '\9473'+        173 -> '\9531'+        174 -> '\9523'+        175 -> '\9547'+        177 -> '\9589'+        178 -> '\9591'+        179 -> '\9474'+        180 -> '\9588'+        181 -> '\9563'+        182 -> '\9557'+        183 -> '\9569'+        184 -> '\9590'+        185 -> '\9560'+        186 -> '\9554'+        187 -> '\9566'+        188 -> '\9552'+        189 -> '\9575'+        190 -> '\9572'+        191 -> '\9532'+        193 -> '\9589'+        194 -> '\9591'+        195 -> '\9553'+        196 -> '\9588'+        197 -> '\9564'+        198 -> '\9558'+        199 -> '\9570'+        200 -> '\9590'+        201 -> '\9561'+        202 -> '\9555'+        203 -> '\9567'+        204 -> '\9472'+        205 -> '\9576'+        206 -> '\9573'+        207 -> '\9532'+        209 -> '\9589'+        210 -> '\9591'+        211 -> '\9553'+        212 -> '\9588'+        213 -> '\9565'+        214 -> '\9559'+        215 -> '\9571'+        216 -> '\9590'+        217 -> '\9562'+        218 -> '\9556'+        219 -> '\9568'+        220 -> '\9552'+        221 -> '\9577'+        222 -> '\9574'+        223 -> '\9532'+        225 -> '\9589'+        226 -> '\9591'+        227 -> '\9474'+        228 -> '\9588'+        229 -> '\9496'+        230 -> '\9488'+        231 -> '\9508'+        232 -> '\9590'+        233 -> '\9492'+        234 -> '\9484'+        235 -> '\9500'+        236 -> '\9472'+        237 -> '\9524'+        238 -> '\9516'+        239 -> '\9532'+        241 -> '\9589'+        242 -> '\9591'+        243 -> '\9474'+        244 -> '\9588'+        245 -> '\9496'+        246 -> '\9488'+        247 -> '\9508'+        248 -> '\9590'+        249 -> '\9492'+        250 -> '\9484'+        251 -> '\9500'+        252 -> '\9472'+        253 -> '\9524'+        254 -> '\9516'+        255 -> '\9532'+        _ -> ' '+    )+    ( \case+        '\9472' -> Just 252+        '\9473' -> Just 172+        '\9474' -> Just 243+        '\9475' -> Just 163+        '\9476' -> Just 76+        '\9478' -> Just 67+        '\9480' -> Just 108+        '\9482' -> Just 99+        '\9484' -> Just 250+        '\9485' -> Just 138+        '\9486' -> Just 154+        '\9487' -> Just 170+        '\9488' -> Just 246+        '\9489' -> Just 134+        '\9490' -> Just 150+        '\9491' -> Just 166+        '\9492' -> Just 249+        '\9493' -> Just 153+        '\9495' -> Just 169+        '\9496' -> Just 245+        '\9497' -> Just 133+        '\9498' -> Just 149+        '\9499' -> Just 165+        '\9500' -> Just 251+        '\9501' -> Just 139+        '\9504' -> Just 155+        '\9507' -> Just 171+        '\9508' -> Just 247+        '\9509' -> Just 135+        '\9512' -> Just 151+        '\9515' -> Just 167+        '\9516' -> Just 254+        '\9519' -> Just 142+        '\9520' -> Just 158+        '\9523' -> Just 174+        '\9524' -> Just 253+        '\9527' -> Just 141+        '\9528' -> Just 157+        '\9531' -> Just 173+        '\9532' -> Just 255+        '\9535' -> Just 143+        '\9538' -> Just 159+        '\9547' -> Just 175+        '\9548' -> Just 44+        '\9550' -> Just 35+        '\9552' -> Just 220+        '\9553' -> Just 211+        '\9554' -> Just 186+        '\9555' -> Just 202+        '\9556' -> Just 218+        '\9557' -> Just 182+        '\9558' -> Just 198+        '\9559' -> Just 214+        '\9560' -> Just 185+        '\9561' -> Just 201+        '\9562' -> Just 217+        '\9563' -> Just 181+        '\9564' -> Just 197+        '\9565' -> Just 213+        '\9566' -> Just 187+        '\9567' -> Just 203+        '\9568' -> Just 219+        '\9569' -> Just 183+        '\9570' -> Just 199+        '\9571' -> Just 215+        '\9572' -> Just 190+        '\9573' -> Just 206+        '\9574' -> Just 222+        '\9575' -> Just 189+        '\9576' -> Just 205+        '\9577' -> Just 221+        '\9581' -> Just 26+        '\9582' -> Just 22+        '\9583' -> Just 21+        '\9584' -> Just 25+        '\9588' -> Just 244+        '\9589' -> Just 241+        '\9590' -> Just 248+        '\9591' -> Just 242+        '\9592' -> Just 164+        '\9593' -> Just 161+        '\9594' -> Just 168+        '\9595' -> Just 162+        _ -> Nothing+    )++--------------------------------------------------------------------------------++-- | A box border which can be rendered to a terminal given a 'BoxDrawingStyle'+--+-- Use the 'Monoid' and 'Semigroup' instances to combine box borders.+--+-- The internal representation is just a 'Word8'; the least-significant four+-- bits specify the base directions of the box drawing (up, down, left, or+-- right), and the most-significant four bits specify the style (see 'rounded',+-- 'dashed2', etc) which has its own special logic for how styles can be+-- combined.+newtype Drawing = Drawing Word8+  deriving newtype (Eq, Ord)++instance Semigroup Drawing where+  (<>) a@(Drawing ab) b@(Drawing bb) =+    Drawing ((ab .|. bb) .&. 0x0f) `setStyle1` (getStyle1 a <> getStyle1 b)++instance Monoid Drawing where+  mempty = Drawing 0++-- | A single box border component+data Drawing1+  = BUp+  | BDown+  | BLeft+  | BRight+  deriving stock (Show, Read, Eq, Ord, Enum, Bounded)++newtype StyleBits = StyleBits Word8++styleBits :: Drawing -> StyleBits+styleBits (Drawing fs) = StyleBits (fs `shiftR` 4)++setStyleBits :: Drawing -> StyleBits -> Drawing+setStyleBits (Drawing fs) (StyleBits s) = Drawing ((fs .&. 0x0f) .|. (s `shiftL` 4))++setStyle1 :: Drawing -> Style1 -> Drawing+setStyle1 b s = setStyleBits b (fromStyle1 s)++data Style1+  = Light+  | Rounded+  | Dashed2+  | Dashed2Heavy+  | Dashed3+  | Dashed3Heavy+  | Dashed4+  | Dashed4Heavy+  | HeavyHoriz+  | HeavyVert+  | Heavy+  | DoubleHoriz+  | DoubleVert+  | Double+  deriving stock (Show, Eq, Ord, Enum, Bounded)++instance Monoid Style1 where+  mempty = Light++instance Semigroup Style1 where+  (<>) DoubleHoriz DoubleVert = Double+  (<>) DoubleVert DoubleHoriz = Double+  (<>) HeavyHoriz HeavyVert = Heavy+  (<>) HeavyVert HeavyHoriz = Heavy+  (<>) Heavy Dashed2 = Dashed2Heavy+  (<>) Dashed2 Heavy = Dashed2Heavy+  (<>) Heavy Dashed3 = Dashed3Heavy+  (<>) Dashed3 Heavy = Dashed3Heavy+  (<>) Heavy Dashed4 = Dashed4Heavy+  (<>) Dashed4 Heavy = Dashed4Heavy+  (<>) a b = max a b++style1 :: Style1 -> Drawing+style1 s = setStyleBits mempty (fromStyle1 s)++fromStyle1 :: Style1 -> StyleBits+fromStyle1 = StyleBits . toEnum . fromEnum++dropStyleBits :: Drawing -> Drawing+dropStyleBits (Drawing w) = Drawing (w .&. 0x0f)++getStyle1 :: Drawing -> Style1+getStyle1 (Drawing w)+  | i >= 0 && i <= fromEnum (maxBound @Style1) = toEnum i+  | otherwise = mempty+  where+    !i = fromIntegral (w `shiftR` 4)++getBorderBitField :: Drawing -> Word8+getBorderBitField (Drawing fs) = fs++bitsToDrawing :: Drawing -> [Drawing1]+bitsToDrawing (Drawing fs) = concat do+  !b1 <- [minBound .. maxBound @Drawing1]+  pure [b1 | testBit fs (fromEnum b1)]++boxBorderBits :: Drawing1 -> Drawing+boxBorderBits = Drawing . bit . fromEnum++-- | Given a box drawing style and a character, determine what 'Drawing' the+-- character is. On error, returns an empty 'Drawing'+read :: BoxDrawingStyle -> Char -> Drawing+read style ch = fromMaybe mempty (lookup style ch)++-- | Get the character that best represents visually overlaying the given box+-- drawing and a character.+overlay :: BoxDrawingStyle -> Drawing -> Char -> Char+overlay style next cur = render style (read style cur <> next)