Use DeriveLift to generate yesod-core's Lift instances
GHC 8.0 and later come with the `DeriveLift` extension for deriving
instances of `Language.Haskell.TH.Syntax.Lift`. `yesod-core` supports
GHC 8.2 and up, so it is able to make use of this. Not only does
`DeriveLift` make for much shorter code, but it also fixes warnings
that you get when compiling `yesod-core` with GHC 8.10 or later:
```
[20 of 31] Compiling Yesod.Routes.TH.Types ( src/Yesod/Routes/TH/Types.hs, interpreted )
src/Yesod/Routes/TH/Types.hs:34:10: warning: [-Wmissing-methods]
• No explicit implementation for
‘liftTyped’
• In the instance declaration for ‘Lift (ResourceTree t)’
|
34 | instance Lift t => Lift (ResourceTree t) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
src/Yesod/Routes/TH/Types.hs:49:10: warning: [-Wmissing-methods]
• No explicit implementation for
‘liftTyped’
• In the instance declaration for ‘Lift (Resource t)’
|
49 | instance Lift t => Lift (Resource t) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^
src/Yesod/Routes/TH/Types.hs:59:10: warning: [-Wmissing-methods]
• No explicit implementation for
‘liftTyped’
• In the instance declaration for ‘Lift (Piece t)’
|
59 | instance Lift t => Lift (Piece t) where
| ^^^^^^^^^^^^^^^^^^^^^^^^
src/Yesod/Routes/TH/Types.hs:78:10: warning: [-Wmissing-methods]
• No explicit implementation for
‘liftTyped’
• In the instance declaration for ‘Lift (Dispatch t)’
|
78 | instance Lift t => Lift (Dispatch t) where
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^
```
This is because `DeriveLift` fills in implementations of `liftTyped`,
a method that was introduced to `Lift` in `template-haskell-2.16.0.0`
(bundled with GHC 8.10).
This commit is contained in:
parent
59f601a34c
commit
29a08425e9
@ -4,6 +4,11 @@
|
|||||||
|
|
||||||
* Add functions for setting description and OG meta [#1663](https://github.com/yesodweb/yesod/pull/1663)
|
* Add functions for setting description and OG meta [#1663](https://github.com/yesodweb/yesod/pull/1663)
|
||||||
|
|
||||||
|
* Use `DeriveLift` to implement the `Lift` instances for `ResourceTree`,
|
||||||
|
`Resource`, `Piece`, and `Dispatch`. Among other benefits, this provides
|
||||||
|
implementations of `liftTyped` on `template-haskell-2.16` (GHC 8.10) or
|
||||||
|
later. [#1664](https://github.com/yesodweb/yesod/pull/1664)
|
||||||
|
|
||||||
## 1.6.17.3
|
## 1.6.17.3
|
||||||
|
|
||||||
* Support for `unliftio-core` 0.2
|
* Support for `unliftio-core` 0.2
|
||||||
|
|||||||
@ -1,5 +1,5 @@
|
|||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE DeriveLift #-}
|
||||||
-- | Warning! This module is considered internal and may have breaking changes
|
-- | Warning! This module is considered internal and may have breaking changes
|
||||||
module Yesod.Routes.TH.Types
|
module Yesod.Routes.TH.Types
|
||||||
( -- * Data types
|
( -- * Data types
|
||||||
@ -21,7 +21,7 @@ import Language.Haskell.TH.Syntax
|
|||||||
data ResourceTree typ
|
data ResourceTree typ
|
||||||
= ResourceLeaf (Resource typ)
|
= ResourceLeaf (Resource typ)
|
||||||
| ResourceParent String CheckOverlap [Piece typ] [ResourceTree typ]
|
| ResourceParent String CheckOverlap [Piece typ] [ResourceTree typ]
|
||||||
deriving (Show, Functor)
|
deriving (Lift, Show, Functor)
|
||||||
|
|
||||||
resourceTreePieces :: ResourceTree typ -> [Piece typ]
|
resourceTreePieces :: ResourceTree typ -> [Piece typ]
|
||||||
resourceTreePieces (ResourceLeaf r) = resourcePieces r
|
resourceTreePieces (ResourceLeaf r) = resourcePieces r
|
||||||
@ -31,10 +31,6 @@ resourceTreeName :: ResourceTree typ -> String
|
|||||||
resourceTreeName (ResourceLeaf r) = resourceName r
|
resourceTreeName (ResourceLeaf r) = resourceName r
|
||||||
resourceTreeName (ResourceParent x _ _ _) = x
|
resourceTreeName (ResourceParent x _ _ _) = x
|
||||||
|
|
||||||
instance Lift t => Lift (ResourceTree t) where
|
|
||||||
lift (ResourceLeaf r) = [|ResourceLeaf $(lift r)|]
|
|
||||||
lift (ResourceParent a b c d) = [|ResourceParent $(lift a) $(lift b) $(lift c) $(lift d)|]
|
|
||||||
|
|
||||||
data Resource typ = Resource
|
data Resource typ = Resource
|
||||||
{ resourceName :: String
|
{ resourceName :: String
|
||||||
, resourcePieces :: [Piece typ]
|
, resourcePieces :: [Piece typ]
|
||||||
@ -42,24 +38,17 @@ data Resource typ = Resource
|
|||||||
, resourceAttrs :: [String]
|
, resourceAttrs :: [String]
|
||||||
, resourceCheck :: CheckOverlap
|
, resourceCheck :: CheckOverlap
|
||||||
}
|
}
|
||||||
deriving (Show, Functor)
|
deriving (Lift, Show, Functor)
|
||||||
|
|
||||||
type CheckOverlap = Bool
|
type CheckOverlap = Bool
|
||||||
|
|
||||||
instance Lift t => Lift (Resource t) where
|
|
||||||
lift (Resource a b c d e) = [|Resource a b c d e|]
|
|
||||||
|
|
||||||
data Piece typ = Static String | Dynamic typ
|
data Piece typ = Static String | Dynamic typ
|
||||||
deriving Show
|
deriving (Lift, Show)
|
||||||
|
|
||||||
instance Functor Piece where
|
instance Functor Piece where
|
||||||
fmap _ (Static s) = Static s
|
fmap _ (Static s) = Static s
|
||||||
fmap f (Dynamic t) = Dynamic (f t)
|
fmap f (Dynamic t) = Dynamic (f t)
|
||||||
|
|
||||||
instance Lift t => Lift (Piece t) where
|
|
||||||
lift (Static s) = [|Static $(lift s)|]
|
|
||||||
lift (Dynamic t) = [|Dynamic $(lift t)|]
|
|
||||||
|
|
||||||
data Dispatch typ =
|
data Dispatch typ =
|
||||||
Methods
|
Methods
|
||||||
{ methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
|
{ methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
|
||||||
@ -69,17 +58,12 @@ data Dispatch typ =
|
|||||||
{ subsiteType :: typ
|
{ subsiteType :: typ
|
||||||
, subsiteFunc :: String
|
, subsiteFunc :: String
|
||||||
}
|
}
|
||||||
deriving Show
|
deriving (Lift, Show)
|
||||||
|
|
||||||
instance Functor Dispatch where
|
instance Functor Dispatch where
|
||||||
fmap f (Methods a b) = Methods (fmap f a) b
|
fmap f (Methods a b) = Methods (fmap f a) b
|
||||||
fmap f (Subsite a b) = Subsite (f a) b
|
fmap f (Subsite a b) = Subsite (f a) b
|
||||||
|
|
||||||
instance Lift t => Lift (Dispatch t) where
|
|
||||||
lift (Methods Nothing b) = [|Methods Nothing $(lift b)|]
|
|
||||||
lift (Methods (Just t) b) = [|Methods (Just $(lift t)) $(lift b)|]
|
|
||||||
lift (Subsite t b) = [|Subsite $(lift t) $(lift b)|]
|
|
||||||
|
|
||||||
resourceMulti :: Resource typ -> Maybe typ
|
resourceMulti :: Resource typ -> Maybe typ
|
||||||
resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t
|
resourceMulti Resource { resourceDispatch = Methods (Just t) _ } = Just t
|
||||||
resourceMulti _ = Nothing
|
resourceMulti _ = Nothing
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user