haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use DeriveLift to generate yesod-core's Lift instances

Browse Source 
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:
Ryan Scott 2020-03-31 07:49:15 -04:00
parent 59f601a34c
commit 29a08425e9
2 changed files with 10 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
yesod-core/ChangeLog.md
View File

@ -4,6 +4,11 @@
* 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
* Support for `unliftio-core` 0.2

26
yesod-core/src/Yesod/Routes/TH/Types.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveLift #-}
-- | Warning! This module is considered internal and may have breaking changes
module Yesod.Routes.TH.Types
( -- * Data types
@ -21,7 +21,7 @@ import Language.Haskell.TH.Syntax
data ResourceTree typ
= ResourceLeaf (Resource typ)
| ResourceParent String CheckOverlap [Piece typ] [ResourceTree typ]
deriving (Show, Functor)
deriving (Lift, Show, Functor)
resourceTreePieces :: ResourceTree typ -> [Piece typ]
resourceTreePieces (ResourceLeaf r) = resourcePieces r
@ -31,10 +31,6 @@ resourceTreeName :: ResourceTree typ -> String
resourceTreeName (ResourceLeaf r) = resourceName r
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
{ resourceName :: String
, resourcePieces :: [Piece typ]
@ -42,24 +38,17 @@ data Resource typ = Resource
, resourceAttrs :: [String]
, resourceCheck :: CheckOverlap
}
deriving (Show, Functor)
deriving (Lift, Show, Functor)
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
deriving Show
deriving (Lift, Show)
instance Functor Piece where
fmap _ (Static s) = Static s
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 =
Methods
{ methodsMulti :: Maybe typ -- ^ type of the multi piece at the end
@ -69,17 +58,12 @@ data Dispatch typ =
{ subsiteType :: typ
, subsiteFunc :: String
}
deriving Show
deriving (Lift, Show)
instance Functor Dispatch where
fmap f (Methods a b) = Methods (fmap 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 { resourceDispatch = Methods (Just t) _ } = Just t
resourceMulti _ = Nothing