src/Symantic/Plaintext/Output.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   3
   4 module Symantic.Plaintext.Output where
   5
   6 import Data.Bool
   7 import Data.Char (Char)
   8 import Data.Eq (Eq (..))
   9 import Data.Foldable qualified as Fold
  10 import Data.Function (id, ($), (.))
  11 import Data.Function qualified as Fun
  12 import Data.Functor (Functor, (<$>))
  13 import Data.List qualified as List
  14 import Data.Maybe (Maybe (..))
  15 import Data.Monoid (Monoid (..))
  16 import Data.Semigroup (Semigroup (..))
  17 import Data.Semigroup qualified as SG
  18 import Data.String (IsString (..), String)
  19 import Data.Text qualified as T
  20 import Data.Text.Lazy qualified as TL
  21 import Data.Text.Lazy.Builder qualified as TLB
  22 import Prelude (fromIntegral)
  23
  24 import Numeric.Natural (Natural)
  25 import Symantic.Plaintext.Classes
  26 import Text.Show (Show)
  27
  28 -- * Class 'Outputable'
  29 class
  30   ( IsString o
  31   , Convertible Char o
  32   , Convertible String o
  33   , Convertible T.Text o
  34   , Convertible TL.Text o
  35   , Monoid o
  36   ) =>
  37   Outputable o
  38   where
  39   char :: Char -> o
  40   nl :: o
  41   repeatedChar :: Width -> Char -> o
  42 instance Outputable String where
  43   char = (: [])
  44   nl = "\n"
  45   repeatedChar w c = fromString (List.replicate (fromIntegral w) c)
  46 instance Outputable T.Text where
  47   char = T.singleton
  48   nl = "\n"
  49   repeatedChar w = T.replicate (fromIntegral w) . T.singleton
  50 instance Outputable TL.Text where
  51   char = TL.singleton
  52   nl = "\n"
  53   repeatedChar w = TL.replicate (fromIntegral w) . TL.singleton
  54
  55 -- * Class 'Lengthable'
  56 class Lengthable o where
  57   length :: o -> Column
  58   isEmpty :: o -> Bool
  59   isEmpty x = length x == 0
  60 instance Lengthable Char where
  61   length _ = 1
  62   isEmpty = Fun.const False
  63 instance Lengthable String where
  64   length = fromIntegral . List.length
  65   isEmpty = Fold.null
  66 instance Lengthable T.Text where
  67   length = fromIntegral . T.length
  68   isEmpty = T.null
  69 instance Lengthable TL.Text where
  70   length = fromIntegral . TL.length
  71   isEmpty = TL.null
  72
  73 -- * Class 'Dimensionable'
  74 class Dimensionable a where
  75   width :: a -> Natural
  76   height :: a -> Natural
  77 instance Dimensionable a => Dimensionable (Line a) where
  78   width = width . unLine
  79   height _ = 1
  80 instance Dimensionable a => Dimensionable (Word a) where
  81   width _ = 1
  82   height _ = 1
  83
  84 -- * Class 'Splitable'
  85 class (Lengthable o, Monoid o) => Splitable o where
  86   tail :: o -> Maybe (o)
  87   break :: (Char -> Bool) -> o -> (o, o)
  88   span :: (Char -> Bool) -> o -> (o, o)
  89   span f = break (not . f)
  90
  91   splitOnChar :: (Char -> Bool) -> o -> [o]
  92   splitOnChar f d0 =
  93     if isEmpty d0 then [] else go d0
  94     where
  95       go o =
  96         let (l, r) = f `break` o
  97          in l : case tail r of
  98               Nothing -> []
  99               Just rt
 100                 | isEmpty rt -> [mempty]
 101                 | otherwise -> go rt
 102   splitOnCharNoEmpty :: (Char -> Bool) -> o -> [o]
 103   splitOnCharNoEmpty f x =
 104     let (l, r) = f `break` x
 105      in [l | not (isEmpty l)]
 106         SG.<> case tail r of
 107           Nothing -> []
 108           Just rt -> splitOnCharNoEmpty f rt
 109 instance Splitable String where
 110   tail [] = Nothing
 111   tail s = Just $ List.tail s
 112   break = List.break
 113 instance Splitable T.Text where
 114   tail "" = Nothing
 115   tail s = Just $ T.tail s
 116   break = T.break
 117 instance Splitable TL.Text where
 118   tail "" = Nothing
 119   tail s = Just $ TL.tail s
 120   break = TL.break
 121
 122 -- ** Type 'Line'
 123 newtype Line o = Line o
 124   deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
 125   deriving stock (Show)
 126
 127 unLine :: Line o -> o
 128 unLine (Line x) = x
 129 lines :: Splitable o => o -> [Line o]
 130 linesNoEmpty :: Splitable o => o -> [Line o]
 131 lines = (Line <$>) . splitOnChar (== '\n')
 132 linesNoEmpty = (Line <$>) . splitOnCharNoEmpty (== '\n')
 133
 134 -- ** Type 'Word'
 135 newtype Word o = Word o
 136   deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
 137   deriving stock (Show)
 138
 139 unWord :: Word o -> o
 140 unWord (Word x) = x
 141 words :: Splitable o => Line o -> [Word o]
 142 wordsNoEmpty :: Splitable o => Line o -> [Word o]
 143 words = (Word <$>) . splitOnChar (== ' ') . unLine
 144 wordsNoEmpty = (Word <$>) . splitOnCharNoEmpty (== ' ') . unLine
 145
 146 -- * Class 'Convertible'
 147 class Convertible i o where
 148   convert :: i -> o
 149 instance Convertible Char String where
 150   convert = (: [])
 151 instance Convertible String String where
 152   convert = id
 153 instance Convertible T.Text String where
 154   convert = T.unpack
 155 instance Convertible TL.Text String where
 156   convert = TL.unpack
 157 instance Convertible Char T.Text where
 158   convert = T.singleton
 159 instance Convertible String T.Text where
 160   convert = T.pack
 161 instance Convertible T.Text T.Text where
 162   convert = id
 163 instance Convertible TL.Text T.Text where
 164   convert = TL.toStrict
 165 instance Convertible Char TL.Text where
 166   convert = TL.singleton
 167 instance Convertible String TL.Text where
 168   convert = TL.pack
 169 instance Convertible T.Text TL.Text where
 170   convert = TL.fromStrict
 171 instance Convertible TL.Text TL.Text where
 172   convert = id
 173 instance Convertible Char TLB.Builder where
 174   convert = TLB.singleton
 175 instance Convertible String TLB.Builder where
 176   convert = fromString
 177 instance Convertible T.Text TLB.Builder where
 178   convert = TLB.fromText
 179 instance Convertible TL.Text TLB.Builder where
 180   convert = TLB.fromLazyText
 181 instance Convertible TLB.Builder TLB.Builder where
 182   convert = id
 183 instance Convertible i o => Convertible (Word i) (Word o) where
 184   convert = Word . convert . unWord
 185 instance Convertible i o => Convertible (Line i) (Line o) where
 186   convert = Line . convert . unLine