From 8179aba8aa35ac3fa518a2a398b0f66b67092433 Mon Sep 17 00:00:00 2001 From: Saku Laesvuori 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