Skip to content
Snippets Groups Projects
Commit 2f6362ed authored by Simon Hengel's avatar Simon Hengel
Browse files

Get rid of StandaloneDeriving

parent 36ad2fd7
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable #-} {-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
{-# LANGUAGE DeriveTraversable, StandaloneDeriving #-}
-- | -- |
-- Module : Documentation.Haddock.Types -- Module : Documentation.Haddock.Types
...@@ -24,12 +23,6 @@ instance Foldable Header where ...@@ -24,12 +23,6 @@ instance Foldable Header where
instance Traversable Header where instance Traversable Header where
traverse f (Header l a) = Header l `fmap` f a traverse f (Header l a) = Header l `fmap` f a
deriving instance Show a => Show (Header a)
deriving instance (Show a, Show b) => Show (DocH a b)
deriving instance Eq a => Eq (Header a)
deriving instance (Eq a, Eq b) => Eq (DocH a b)
data Hyperlink = Hyperlink data Hyperlink = Hyperlink
{ hyperlinkUrl :: String { hyperlinkUrl :: String
, hyperlinkLabel :: Maybe String , hyperlinkLabel :: Maybe String
...@@ -44,7 +37,7 @@ data Picture = Picture ...@@ -44,7 +37,7 @@ data Picture = Picture
data Header id = Header data Header id = Header
{ headerLevel :: Int { headerLevel :: Int
, headerTitle :: id , headerTitle :: id
} deriving Functor } deriving (Eq, Show, Functor)
data Example = Example data Example = Example
{ exampleExpression :: String { exampleExpression :: String
...@@ -73,4 +66,4 @@ data DocH mod id ...@@ -73,4 +66,4 @@ data DocH mod id
| DocProperty String | DocProperty String
| DocExamples [Example] | DocExamples [Example]
| DocHeader (Header (DocH mod id)) | DocHeader (Header (DocH mod id))
deriving (Functor, Foldable, Traversable) deriving (Eq, Show, Functor, Foldable, Traversable)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment