{-# LANGUAGE DeriveGeneric #-}

-- | This module defines PrinterOpts and related types
module Ormolu.Config.Types
  ( PrinterOpts (..),
    CommaStyle (..),
    FunctionArrowsStyle (..),
    HaddockPrintStyle (..),
    HaddockPrintStyleModule (..),
    ImportExportStyle (..),
    LetStyle (..),
    InStyle (..),
    Unicode (..),
  )
where

import GHC.Generics (Generic)

-- | Options controlling formatting output.
data PrinterOpts f = PrinterOpts
  { -- | Number of spaces to use for indentation
    forall (f :: * -> *). PrinterOpts f -> f Int
poIndentation :: f Int,
    -- | How to style arrows in type signatures
    forall (f :: * -> *). PrinterOpts f -> f FunctionArrowsStyle
poFunctionArrows :: f FunctionArrowsStyle,
    -- | Whether to place commas at start or end of lines
    forall (f :: * -> *). PrinterOpts f -> f CommaStyle
poCommaStyle :: f CommaStyle,
    -- | Styling of import/export lists
    forall (f :: * -> *). PrinterOpts f -> f ImportExportStyle
poImportExportStyle :: f ImportExportStyle,
    -- | Whether to indent `where` blocks
    forall (f :: * -> *). PrinterOpts f -> f Bool
poIndentWheres :: f Bool,
    -- | Leave space before opening record brace
    forall (f :: * -> *). PrinterOpts f -> f Bool
poRecordBraceSpace :: f Bool,
    -- | Number of newlines between top-level decls
    forall (f :: * -> *). PrinterOpts f -> f Int
poNewlinesBetweenDecls :: f Int,
    -- | How to print doc comments
    forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyle
poHaddockStyle :: f HaddockPrintStyle,
    -- | How to print the module docstring (defaults to poHaddockStyle)
    forall (f :: * -> *). PrinterOpts f -> f HaddockPrintStyleModule
poHaddockStyleModule :: f HaddockPrintStyleModule,
    -- | Styling of let blocks
    forall (f :: * -> *). PrinterOpts f -> f LetStyle
poLetStyle :: f LetStyle,
    -- | How to align in keyword
    forall (f :: * -> *). PrinterOpts f -> f InStyle
poInStyle :: f InStyle,
    -- | Output Unicode syntax
    forall (f :: * -> *). PrinterOpts f -> f Unicode
poUnicode :: f Unicode,
    -- | Be less opinionated about spaces/newlines etc.
    forall (f :: * -> *). PrinterOpts f -> f Bool
poRespectful :: f Bool
  }
  deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
$cto :: forall (f :: * -> *) x. Rep (PrinterOpts f) x -> PrinterOpts f
$cfrom :: forall (f :: * -> *) x. PrinterOpts f -> Rep (PrinterOpts f) x
Generic)

data CommaStyle
  = Leading
  | Trailing
  deriving (CommaStyle -> CommaStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c== :: CommaStyle -> CommaStyle -> Bool
Eq, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommaStyle] -> ShowS
$cshowList :: [CommaStyle] -> ShowS
show :: CommaStyle -> String
$cshow :: CommaStyle -> String
showsPrec :: Int -> CommaStyle -> ShowS
$cshowsPrec :: Int -> CommaStyle -> ShowS
Show, Int -> CommaStyle
CommaStyle -> Int
CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle
CommaStyle -> CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
enumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFrom :: CommaStyle -> [CommaStyle]
$cenumFrom :: CommaStyle -> [CommaStyle]
fromEnum :: CommaStyle -> Int
$cfromEnum :: CommaStyle -> Int
toEnum :: Int -> CommaStyle
$ctoEnum :: Int -> CommaStyle
pred :: CommaStyle -> CommaStyle
$cpred :: CommaStyle -> CommaStyle
succ :: CommaStyle -> CommaStyle
$csucc :: CommaStyle -> CommaStyle
Enum, CommaStyle
forall a. a -> a -> Bounded a
maxBound :: CommaStyle
$cmaxBound :: CommaStyle
minBound :: CommaStyle
$cminBound :: CommaStyle
Bounded)

data FunctionArrowsStyle
  = TrailingArrows
  | LeadingArrows
  | LeadingArgsArrows
  deriving (FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
$c/= :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
== :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
$c== :: FunctionArrowsStyle -> FunctionArrowsStyle -> Bool
Eq, Int -> FunctionArrowsStyle -> ShowS
[FunctionArrowsStyle] -> ShowS
FunctionArrowsStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FunctionArrowsStyle] -> ShowS
$cshowList :: [FunctionArrowsStyle] -> ShowS
show :: FunctionArrowsStyle -> String
$cshow :: FunctionArrowsStyle -> String
showsPrec :: Int -> FunctionArrowsStyle -> ShowS
$cshowsPrec :: Int -> FunctionArrowsStyle -> ShowS
Show, Int -> FunctionArrowsStyle
FunctionArrowsStyle -> Int
FunctionArrowsStyle -> [FunctionArrowsStyle]
FunctionArrowsStyle -> FunctionArrowsStyle
FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
$cenumFromThenTo :: FunctionArrowsStyle
-> FunctionArrowsStyle
-> FunctionArrowsStyle
-> [FunctionArrowsStyle]
enumFromTo :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFromTo :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
enumFromThen :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFromThen :: FunctionArrowsStyle -> FunctionArrowsStyle -> [FunctionArrowsStyle]
enumFrom :: FunctionArrowsStyle -> [FunctionArrowsStyle]
$cenumFrom :: FunctionArrowsStyle -> [FunctionArrowsStyle]
fromEnum :: FunctionArrowsStyle -> Int
$cfromEnum :: FunctionArrowsStyle -> Int
toEnum :: Int -> FunctionArrowsStyle
$ctoEnum :: Int -> FunctionArrowsStyle
pred :: FunctionArrowsStyle -> FunctionArrowsStyle
$cpred :: FunctionArrowsStyle -> FunctionArrowsStyle
succ :: FunctionArrowsStyle -> FunctionArrowsStyle
$csucc :: FunctionArrowsStyle -> FunctionArrowsStyle
Enum, FunctionArrowsStyle
forall a. a -> a -> Bounded a
maxBound :: FunctionArrowsStyle
$cmaxBound :: FunctionArrowsStyle
minBound :: FunctionArrowsStyle
$cminBound :: FunctionArrowsStyle
Bounded)

data HaddockPrintStyle
  = HaddockSingleLine
  | HaddockMultiLine
  | HaddockMultiLineCompact
  deriving (HaddockPrintStyle -> HaddockPrintStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c/= :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
$c== :: HaddockPrintStyle -> HaddockPrintStyle -> Bool
Eq, Int -> HaddockPrintStyle -> ShowS
[HaddockPrintStyle] -> ShowS
HaddockPrintStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaddockPrintStyle] -> ShowS
$cshowList :: [HaddockPrintStyle] -> ShowS
show :: HaddockPrintStyle -> String
$cshow :: HaddockPrintStyle -> String
showsPrec :: Int -> HaddockPrintStyle -> ShowS
$cshowsPrec :: Int -> HaddockPrintStyle -> ShowS
Show, Int -> HaddockPrintStyle
HaddockPrintStyle -> Int
HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle -> HaddockPrintStyle
HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThenTo :: HaddockPrintStyle
-> HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromTo :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFromThen :: HaddockPrintStyle -> HaddockPrintStyle -> [HaddockPrintStyle]
enumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
$cenumFrom :: HaddockPrintStyle -> [HaddockPrintStyle]
fromEnum :: HaddockPrintStyle -> Int
$cfromEnum :: HaddockPrintStyle -> Int
toEnum :: Int -> HaddockPrintStyle
$ctoEnum :: Int -> HaddockPrintStyle
pred :: HaddockPrintStyle -> HaddockPrintStyle
$cpred :: HaddockPrintStyle -> HaddockPrintStyle
succ :: HaddockPrintStyle -> HaddockPrintStyle
$csucc :: HaddockPrintStyle -> HaddockPrintStyle
Enum, HaddockPrintStyle
forall a. a -> a -> Bounded a
maxBound :: HaddockPrintStyle
$cmaxBound :: HaddockPrintStyle
minBound :: HaddockPrintStyle
$cminBound :: HaddockPrintStyle
Bounded)

data HaddockPrintStyleModule
  = PrintStyleInherit
  | PrintStyleOverride HaddockPrintStyle
  deriving (HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
$c/= :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
== :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
$c== :: HaddockPrintStyleModule -> HaddockPrintStyleModule -> Bool
Eq, Int -> HaddockPrintStyleModule -> ShowS
[HaddockPrintStyleModule] -> ShowS
HaddockPrintStyleModule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HaddockPrintStyleModule] -> ShowS
$cshowList :: [HaddockPrintStyleModule] -> ShowS
show :: HaddockPrintStyleModule -> String
$cshow :: HaddockPrintStyleModule -> String
showsPrec :: Int -> HaddockPrintStyleModule -> ShowS
$cshowsPrec :: Int -> HaddockPrintStyleModule -> ShowS
Show)

data ImportExportStyle
  = ImportExportLeading
  | ImportExportTrailing
  | ImportExportDiffFriendly
  deriving (ImportExportStyle -> ImportExportStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportExportStyle -> ImportExportStyle -> Bool
$c/= :: ImportExportStyle -> ImportExportStyle -> Bool
== :: ImportExportStyle -> ImportExportStyle -> Bool
$c== :: ImportExportStyle -> ImportExportStyle -> Bool
Eq, Int -> ImportExportStyle -> ShowS
[ImportExportStyle] -> ShowS
ImportExportStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportExportStyle] -> ShowS
$cshowList :: [ImportExportStyle] -> ShowS
show :: ImportExportStyle -> String
$cshow :: ImportExportStyle -> String
showsPrec :: Int -> ImportExportStyle -> ShowS
$cshowsPrec :: Int -> ImportExportStyle -> ShowS
Show, Int -> ImportExportStyle
ImportExportStyle -> Int
ImportExportStyle -> [ImportExportStyle]
ImportExportStyle -> ImportExportStyle
ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromThenTo :: ImportExportStyle
-> ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFromTo :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromTo :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFromThen :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
$cenumFromThen :: ImportExportStyle -> ImportExportStyle -> [ImportExportStyle]
enumFrom :: ImportExportStyle -> [ImportExportStyle]
$cenumFrom :: ImportExportStyle -> [ImportExportStyle]
fromEnum :: ImportExportStyle -> Int
$cfromEnum :: ImportExportStyle -> Int
toEnum :: Int -> ImportExportStyle
$ctoEnum :: Int -> ImportExportStyle
pred :: ImportExportStyle -> ImportExportStyle
$cpred :: ImportExportStyle -> ImportExportStyle
succ :: ImportExportStyle -> ImportExportStyle
$csucc :: ImportExportStyle -> ImportExportStyle
Enum, ImportExportStyle
forall a. a -> a -> Bounded a
maxBound :: ImportExportStyle
$cmaxBound :: ImportExportStyle
minBound :: ImportExportStyle
$cminBound :: ImportExportStyle
Bounded)

data LetStyle
  = LetAuto
  | LetInline
  | LetNewline
  | LetMixed
  deriving (LetStyle -> LetStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetStyle -> LetStyle -> Bool
$c/= :: LetStyle -> LetStyle -> Bool
== :: LetStyle -> LetStyle -> Bool
$c== :: LetStyle -> LetStyle -> Bool
Eq, Int -> LetStyle -> ShowS
[LetStyle] -> ShowS
LetStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetStyle] -> ShowS
$cshowList :: [LetStyle] -> ShowS
show :: LetStyle -> String
$cshow :: LetStyle -> String
showsPrec :: Int -> LetStyle -> ShowS
$cshowsPrec :: Int -> LetStyle -> ShowS
Show, Int -> LetStyle
LetStyle -> Int
LetStyle -> [LetStyle]
LetStyle -> LetStyle
LetStyle -> LetStyle -> [LetStyle]
LetStyle -> LetStyle -> LetStyle -> [LetStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LetStyle -> LetStyle -> LetStyle -> [LetStyle]
$cenumFromThenTo :: LetStyle -> LetStyle -> LetStyle -> [LetStyle]
enumFromTo :: LetStyle -> LetStyle -> [LetStyle]
$cenumFromTo :: LetStyle -> LetStyle -> [LetStyle]
enumFromThen :: LetStyle -> LetStyle -> [LetStyle]
$cenumFromThen :: LetStyle -> LetStyle -> [LetStyle]
enumFrom :: LetStyle -> [LetStyle]
$cenumFrom :: LetStyle -> [LetStyle]
fromEnum :: LetStyle -> Int
$cfromEnum :: LetStyle -> Int
toEnum :: Int -> LetStyle
$ctoEnum :: Int -> LetStyle
pred :: LetStyle -> LetStyle
$cpred :: LetStyle -> LetStyle
succ :: LetStyle -> LetStyle
$csucc :: LetStyle -> LetStyle
Enum, LetStyle
forall a. a -> a -> Bounded a
maxBound :: LetStyle
$cmaxBound :: LetStyle
minBound :: LetStyle
$cminBound :: LetStyle
Bounded)

data InStyle
  = InLeftAlign
  | InRightAlign
  deriving (InStyle -> InStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InStyle -> InStyle -> Bool
$c/= :: InStyle -> InStyle -> Bool
== :: InStyle -> InStyle -> Bool
$c== :: InStyle -> InStyle -> Bool
Eq, Int -> InStyle -> ShowS
[InStyle] -> ShowS
InStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InStyle] -> ShowS
$cshowList :: [InStyle] -> ShowS
show :: InStyle -> String
$cshow :: InStyle -> String
showsPrec :: Int -> InStyle -> ShowS
$cshowsPrec :: Int -> InStyle -> ShowS
Show, Int -> InStyle
InStyle -> Int
InStyle -> [InStyle]
InStyle -> InStyle
InStyle -> InStyle -> [InStyle]
InStyle -> InStyle -> InStyle -> [InStyle]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: InStyle -> InStyle -> InStyle -> [InStyle]
$cenumFromThenTo :: InStyle -> InStyle -> InStyle -> [InStyle]
enumFromTo :: InStyle -> InStyle -> [InStyle]
$cenumFromTo :: InStyle -> InStyle -> [InStyle]
enumFromThen :: InStyle -> InStyle -> [InStyle]
$cenumFromThen :: InStyle -> InStyle -> [InStyle]
enumFrom :: InStyle -> [InStyle]
$cenumFrom :: InStyle -> [InStyle]
fromEnum :: InStyle -> Int
$cfromEnum :: InStyle -> Int
toEnum :: Int -> InStyle
$ctoEnum :: Int -> InStyle
pred :: InStyle -> InStyle
$cpred :: InStyle -> InStyle
succ :: InStyle -> InStyle
$csucc :: InStyle -> InStyle
Enum, InStyle
forall a. a -> a -> Bounded a
maxBound :: InStyle
$cmaxBound :: InStyle
minBound :: InStyle
$cminBound :: InStyle
Bounded)

data Unicode
  = UnicodeDetect
  | UnicodeAlways
  | UnicodeNever
  deriving (Unicode -> Unicode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unicode -> Unicode -> Bool
$c/= :: Unicode -> Unicode -> Bool
== :: Unicode -> Unicode -> Bool
$c== :: Unicode -> Unicode -> Bool
Eq, Int -> Unicode -> ShowS
[Unicode] -> ShowS
Unicode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unicode] -> ShowS
$cshowList :: [Unicode] -> ShowS
show :: Unicode -> String
$cshow :: Unicode -> String
showsPrec :: Int -> Unicode -> ShowS
$cshowsPrec :: Int -> Unicode -> ShowS
Show, Int -> Unicode
Unicode -> Int
Unicode -> [Unicode]
Unicode -> Unicode
Unicode -> Unicode -> [Unicode]
Unicode -> Unicode -> Unicode -> [Unicode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Unicode -> Unicode -> Unicode -> [Unicode]
$cenumFromThenTo :: Unicode -> Unicode -> Unicode -> [Unicode]
enumFromTo :: Unicode -> Unicode -> [Unicode]
$cenumFromTo :: Unicode -> Unicode -> [Unicode]
enumFromThen :: Unicode -> Unicode -> [Unicode]
$cenumFromThen :: Unicode -> Unicode -> [Unicode]
enumFrom :: Unicode -> [Unicode]
$cenumFrom :: Unicode -> [Unicode]
fromEnum :: Unicode -> Int
$cfromEnum :: Unicode -> Int
toEnum :: Int -> Unicode
$ctoEnum :: Int -> Unicode
pred :: Unicode -> Unicode
$cpred :: Unicode -> Unicode
succ :: Unicode -> Unicode
$csucc :: Unicode -> Unicode
Enum, Unicode
forall a. a -> a -> Bounded a
maxBound :: Unicode
$cmaxBound :: Unicode
minBound :: Unicode
$cminBound :: Unicode
Bounded)