150 lines
5.6 KiB
Diff
150 lines
5.6 KiB
Diff
From 8179aba8aa35ac3fa518a2a398b0f66b67092433 Mon Sep 17 00:00:00 2001
|
|
From: Saku Laesvuori <saku@laesvuori.fi>
|
|
Date: Wed, 5 Aug 2026 10:28:41 +0300
|
|
Subject: [PATCH] Add Template Haskell Lift instance for Doc
|
|
|
|
---
|
|
doclayout.cabal | 1 +
|
|
src/Text/DocLayout.hs | 4 +++-
|
|
src/Text/DocLayout/ANSIFont.hs | 20 +++++++++++---------
|
|
src/Text/DocLayout/Attributed.hs | 6 ++++--
|
|
4 files changed, 19 insertions(+), 12 deletions(-)
|
|
|
|
diff --git a/doclayout.cabal b/doclayout.cabal
|
|
index 83ad188..ff3b545 100644
|
|
--- a/doclayout.cabal
|
|
+++ b/doclayout.cabal
|
|
@@ -32,6 +32,7 @@ library
|
|
containers,
|
|
emojis >=0.1.2,
|
|
mtl,
|
|
+ template-haskell-lift,
|
|
safe
|
|
default-language: Haskell2010
|
|
ghc-options: -Wall -fno-warn-unused-do-bind
|
|
diff --git a/src/Text/DocLayout.hs b/src/Text/DocLayout.hs
|
|
index d4ff1b3..7c252df 100644
|
|
--- a/src/Text/DocLayout.hs
|
|
+++ b/src/Text/DocLayout.hs
|
|
@@ -4,6 +4,7 @@
|
|
{-# LANGUAGE DeriveFoldable #-}
|
|
{-# LANGUAGE DeriveFunctor #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
+{-# LANGUAGE DeriveLift #-}
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE LambdaCase #-}
|
|
@@ -127,6 +128,7 @@ import qualified Data.Text as T
|
|
import Data.Text (Text)
|
|
import qualified Data.Text.Lazy as TL
|
|
import qualified Data.Text.Lazy.Builder as B
|
|
+import Language.Haskell.TH.Lift (Lift)
|
|
import Text.DocLayout.HasChars
|
|
import Text.DocLayout.ANSIFont
|
|
import Text.DocLayout.Attributed
|
|
@@ -159,7 +161,7 @@ data Doc a = Text Int a -- ^ Text with specified width.
|
|
| Linked Text (Doc a) -- ^ A hyperlink
|
|
| Empty
|
|
deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
|
|
- Data, Typeable, Generic)
|
|
+ Data, Typeable, Generic, Lift)
|
|
|
|
|
|
instance Semigroup (Doc a) where
|
|
diff --git a/src/Text/DocLayout/ANSIFont.hs b/src/Text/DocLayout/ANSIFont.hs
|
|
index b952d0b..7002f92 100644
|
|
--- a/src/Text/DocLayout/ANSIFont.hs
|
|
+++ b/src/Text/DocLayout/ANSIFont.hs
|
|
@@ -1,5 +1,6 @@
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
+{-# LANGUAGE DeriveLift #-}
|
|
module Text.DocLayout.ANSIFont
|
|
( Font(..)
|
|
, baseFont
|
|
@@ -17,6 +18,7 @@ module Text.DocLayout.ANSIFont
|
|
) where
|
|
|
|
import Data.Data (Data)
|
|
+import Language.Haskell.TH.Lift (Lift)
|
|
import Data.String
|
|
import Data.Text (Text)
|
|
|
|
@@ -29,18 +31,18 @@ data Font = Font
|
|
ftBackground :: Background,
|
|
ftLink :: Maybe Text
|
|
}
|
|
- deriving (Show, Eq, Read, Data, Ord)
|
|
+ deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
|
|
baseFont :: Font
|
|
baseFont = Font Normal Roman ULNone Unstruck FGDefault BGDefault Nothing
|
|
|
|
-data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord)
|
|
-data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord)
|
|
-data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord)
|
|
-data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord)
|
|
-data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord)
|
|
-data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord)
|
|
-data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord)
|
|
+data Weight = Normal | Bold deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
+data Shape = Roman | Italic deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
+data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Show, Eq, Enum, Read, Data, Ord, Lift)
|
|
+data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
+data Strikeout = Unstruck | Struck deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
+data Foreground = FGDefault | FG Color8 deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
+data Background = BGDefault | BG Color8 deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
|
|
data StyleReq
|
|
= RWeight Weight
|
|
@@ -49,7 +51,7 @@ data StyleReq
|
|
| RBackground Background
|
|
| RUnderline Underline
|
|
| RStrikeout Strikeout
|
|
- deriving (Show, Eq, Read, Data, Ord)
|
|
+ deriving (Show, Eq, Read, Data, Ord, Lift)
|
|
|
|
(~>) :: Font -> StyleReq -> Font
|
|
(~>) f (RWeight w) = f{ftWeight = w}
|
|
diff --git a/src/Text/DocLayout/Attributed.hs b/src/Text/DocLayout/Attributed.hs
|
|
index 46574a1..24124c3 100644
|
|
--- a/src/Text/DocLayout/Attributed.hs
|
|
+++ b/src/Text/DocLayout/Attributed.hs
|
|
@@ -1,4 +1,5 @@
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
+{-# LANGUAGE DeriveLift #-}
|
|
{-# LANGUAGE DeriveTraversable #-}
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
@@ -9,6 +10,7 @@ import Data.String
|
|
import Text.DocLayout.ANSIFont (Font, baseFont)
|
|
import Data.Data (Data, Typeable)
|
|
import GHC.Generics
|
|
+import Language.Haskell.TH.Lift (Lift)
|
|
import Data.Sequence ((><))
|
|
import qualified Data.Sequence as S
|
|
import Data.Text (Text)
|
|
@@ -18,7 +20,7 @@ type Link = Maybe Text
|
|
-- | Font attributes.
|
|
data Attr a = Attr Link Font a
|
|
deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
|
|
- Data, Typeable, Generic)
|
|
+ Data, Typeable, Generic, Lift)
|
|
|
|
instance Semigroup a => Semigroup (Attr a) where
|
|
(<>) (Attr l f x) (Attr _ _ y) = Attr l f $ x <> y -- This is arbitrary
|
|
@@ -29,7 +31,7 @@ instance (IsString a, Monoid a) => Monoid (Attr a) where
|
|
-- | A sequence of strings with font attributes.
|
|
newtype Attributed a = Attributed (S.Seq (Attr a))
|
|
deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable,
|
|
- Data, Typeable, Generic)
|
|
+ Data, Typeable, Generic, Lift)
|
|
|
|
fromList :: [Attr a] -> Attributed a
|
|
fromList = Attributed . S.fromList
|
|
|
|
base-commit: aa2e9d853b7c26f49d3b540f7ca0625e612503ce
|
|
--
|
|
2.54.0
|
|
|