shakespeare 2.0.24 → 2.0.24.1
raw patch · 6 files changed
+44/−83 lines, 6 filesdep +th-lift
Dependencies added: th-lift
Files
- ChangeLog.md +4/−0
- Text/Hamlet/Parse.hs +7/−11
- Text/Internal/Css.hs +12/−13
- Text/Shakespeare.hs +12/−26
- Text/Shakespeare/Base.hs +4/−31
- shakespeare.cabal +5/−2
ChangeLog.md view
@@ -1,5 +1,9 @@ # ChangeLog for shakespeare +### 2.0.24.1++* Derive Lift instances wherever possible [#252](https://github.com/yesodweb/shakespeare/pull/252)+ ### 2.0.24 * Fix build errors with GHC 8.10.1-alpha2 [#245](https://github.com/yesodweb/shakespeare/pull/245)
Text/Hamlet/Parse.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleInstances #-}@@ -30,7 +31,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Maybe (mapMaybe, fromMaybe, isNothing)-import Language.Haskell.TH.Syntax (Lift (..))+import Language.Haskell.TH.Syntax hiding (Module) data Result v = Error String | Ok v deriving (Show, Eq, Read, Data, Typeable)@@ -614,24 +615,19 @@ -- | Mapping from short names in \"$doctype\" statements to full doctype. , hamletDoctypeNames :: [(String, String)] }+ deriving Lift data NewlineStyle = NoNewlines -- ^ never add newlines | NewlinesText -- ^ add newlines between consecutive text lines | AlwaysNewlines -- ^ add newlines everywhere | DefaultNewlineStyle- deriving Show--instance Lift NewlineStyle where- lift NoNewlines = [|NoNewlines|]- lift NewlinesText = [|NewlinesText|]- lift AlwaysNewlines = [|AlwaysNewlines|]- lift DefaultNewlineStyle = [|DefaultNewlineStyle|]+ deriving (Show, Lift) instance Lift (String -> CloseStyle) where lift _ = [|\s -> htmlCloseStyle s|]--instance Lift HamletSettings where- lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif -- See the html specification for a list of all void elements:
Text/Internal/Css.hs view
@@ -2,6 +2,8 @@ -- | This module is only being exposed to work around a GHC bug, its API is not stable {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveLift #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -67,6 +69,7 @@ { mixinAttrs :: ![Attr Resolved] , mixinBlocks :: ![Block Resolved] }+ deriving Lift instance Semigroup Mixin where Mixin a x <> Mixin b y = Mixin (a ++ b) (x ++ y) instance Monoid Mixin where@@ -94,7 +97,7 @@ | ContentUrl Deref | ContentUrlParam Deref | ContentMixin Deref- deriving (Show, Eq)+ deriving (Show, Eq, Lift) type Contents = [Content] @@ -510,23 +513,19 @@ | haveWhiteSpace = fromString ";\n" | otherwise = singleton ';' -instance Lift Mixin where- lift (Mixin a b) = [|Mixin a b|]-instance Lift (Attr Unresolved) where- lift (Attr k v) = [|Attr k v :: Attr Unresolved |]+deriving instance Lift (Attr Unresolved) instance Lift (Attr Resolved) where lift (Attr k v) = [|Attr $(liftBuilder k) $(liftBuilder v) :: Attr Resolved |]+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif liftBuilder :: Builder -> Q Exp liftBuilder b = [|fromText $ pack $(lift $ TL.unpack $ toLazyText b)|] -instance Lift Content where- lift (ContentRaw s) = [|ContentRaw s|]- lift (ContentVar d) = [|ContentVar d|]- lift (ContentUrl d) = [|ContentUrl d|]- lift (ContentUrlParam d) = [|ContentUrlParam d|]- lift (ContentMixin m) = [|ContentMixin m|]-instance Lift (Block Unresolved) where- lift (Block a b c d) = [|Block a b c d|]+deriving instance Lift (Block Unresolved) instance Lift (Block Resolved) where lift (Block a b () ()) = [|Block $(liftBuilder a) b () ()|]+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif
Text/Shakespeare.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveLift #-} {-# OPTIONS_GHC -fno-warn-missing-fields #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | NOTE: This module should be considered internal, and will be hidden in@@ -40,6 +41,7 @@ import Text.Parsec.Prim (modifyState, Parsec) import Language.Haskell.TH.Quote (QuasiQuoter (..)) import Language.Haskell.TH (appE)+import Language.Haskell.TH.Lift () -- Import orphan Lift Name instance import Language.Haskell.TH.Syntax import Data.Text.Lazy.Builder (Builder, fromText) #if !MIN_VERSION_base(4,11,0)@@ -97,6 +99,7 @@ , preEscapeIgnoreLine :: [Char] , wrapInsertion :: Maybe WrapInsertion }+ deriving Lift data WrapInsertion = WrapInsertion { wrapInsertionIndent :: Maybe String@@ -106,10 +109,11 @@ , wrapInsertionEnd :: String , wrapInsertionAddParens :: Bool }+ deriving Lift data PreConversion = ReadProcess String [String] | Id- + deriving Lift data ShakespeareSettings = ShakespeareSettings@@ -137,38 +141,20 @@ , modifyFinalValue = Nothing } -instance Lift PreConvert where- lift (PreConvert convert ignore comment wrapInsertion) =- [|PreConvert $(lift convert) $(lift ignore) $(lift comment) $(lift wrapInsertion)|]--instance Lift WrapInsertion where- lift (WrapInsertion indent sb sep sc e wp) =- [|WrapInsertion $(lift indent) $(lift sb) $(lift sep) $(lift sc) $(lift e) $(lift wp)|]--instance Lift PreConversion where- lift (ReadProcess command args) =- [|ReadProcess $(lift command) $(lift args)|]- lift Id = [|Id|]- instance Lift ShakespeareSettings where lift (ShakespeareSettings x1 x2 x3 x4 x5 x6 x7 x8 x9) = [|ShakespeareSettings $(lift x1) $(lift x2) $(lift x3) $(liftExp x4) $(liftExp x5) $(liftExp x6) $(lift x7) $(lift x8) $(liftMExp x9)|] where- liftExp (VarE n) = [|VarE $(liftName n)|]- liftExp (ConE n) = [|ConE $(liftName n)|]+ liftExp (VarE n) = [|VarE $(lift n)|]+ liftExp (ConE n) = [|ConE $(lift n)|] liftExp _ = error "liftExp only supports VarE and ConE" liftMExp Nothing = [|Nothing|] liftMExp (Just e) = [|Just|] `appE` liftExp e- liftName (Name (OccName a) b) = [|Name (OccName $(lift a)) $(liftFlavour b)|]- liftFlavour NameS = [|NameS|]- liftFlavour (NameQ (ModName a)) = [|NameQ (ModName $(lift a))|]- liftFlavour (NameU _) = error "liftFlavour NameU" -- [|NameU $(lift $ fromIntegral a)|]- liftFlavour (NameL _) = error "liftFlavour NameL" -- [|NameU $(lift $ fromIntegral a)|]- liftFlavour (NameG ns (PkgName p) (ModName m)) = [|NameG $(liftNS ns) (PkgName $(lift p)) (ModName $(lift m))|]- liftNS VarName = [|VarName|]- liftNS DataName = [|DataName|]+#if MIN_VERSION_template_haskell(2,16,0)+ liftTyped = unsafeTExpCoerce . lift+#endif type QueryParameters = [(TS.Text, TS.Text)] type RenderUrl url = (url -> QueryParameters -> TS.Text)@@ -195,7 +181,7 @@ compressContents (ContentRaw x:ContentRaw y:z) = compressContents $ ContentRaw (x ++ y) : z compressContents (x:y) = x : compressContents y- + parseContents :: ShakespeareSettings -> Parser Contents parseContents = many1 . parseContent where@@ -274,7 +260,7 @@ <> "(" <> mconcat (intersperse ", " vars) <> ");\n"- where + where removeTrailingSemiColon = reverse $ dropWhile (\c -> c == ';' || isSpace c) (reverse str)
Text/Shakespeare/Base.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveLift #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE CPP #-} -- | General parsers, functions and datatypes for all Shakespeare languages.@@ -41,7 +42,7 @@ import Control.Monad (when) newtype Ident = Ident String- deriving (Show, Eq, Read, Data, Typeable, Ord)+ deriving (Show, Eq, Read, Data, Typeable, Ord, Lift) type Scope = [(Ident, Exp)] @@ -53,35 +54,7 @@ | DerefBranch Deref Deref | DerefList [Deref] | DerefTuple [Deref]- deriving (Show, Eq, Read, Data, Typeable, Ord)--instance Lift Ident where- lift (Ident s) = [|Ident|] `appE` lift s-instance Lift Deref where- lift (DerefModulesIdent v s) = do- dl <- [|DerefModulesIdent|]- v' <- lift v- s' <- lift s- return $ dl `AppE` v' `AppE` s'- lift (DerefIdent s) = do- dl <- [|DerefIdent|]- s' <- lift s- return $ dl `AppE` s'- lift (DerefBranch x y) = do- x' <- lift x- y' <- lift y- db <- [|DerefBranch|]- return $ db `AppE` x' `AppE` y'- lift (DerefIntegral i) = [|DerefIntegral|] `appE` lift i- lift (DerefRational r) = do- n <- lift $ numerator r- d <- lift $ denominator r- per <- [|(%) :: Int -> Int -> Ratio Int|]- dr <- [|DerefRational|]- return $ dr `AppE` InfixE (Just n) per (Just d)- lift (DerefString s) = [|DerefString|] `appE` lift s- lift (DerefList x) = [|DerefList $(lift x)|]- lift (DerefTuple x) = [|DerefTuple $(lift x)|]+ deriving (Show, Eq, Read, Data, Typeable, Ord, Lift) derefParens, derefCurlyBrackets :: UserParser a Deref derefParens = between (char '(') (char ')') parseDeref@@ -298,7 +271,7 @@ readUtf8File fp = do h <- SIO.openFile fp SIO.ReadMode SIO.hSetEncoding h SIO.utf8_bom- ret <- TIO.hGetContents h + ret <- TIO.hGetContents h return $ #ifdef WINDOWS TL.filter ('\r'/=) ret
shakespeare.cabal view
@@ -1,5 +1,5 @@ name: shakespeare-version: 2.0.24+version: 2.0.24.1 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>@@ -18,7 +18,7 @@ category: Web, Yesod stability: Stable-cabal-version: >= 1.8+cabal-version: >= 1.10 build-type: Simple homepage: http://www.yesodweb.com/book/shakespearean-templates extra-source-files:@@ -34,6 +34,7 @@ ChangeLog.md library+ default-language: Haskell2010 build-depends: base >= 4.9 && < 5 , time >= 1 , containers@@ -52,6 +53,7 @@ , vector , unordered-containers , scientific >= 0.3.0.0+ , th-lift exposed-modules: Text.Shakespeare.I18N Text.Shakespeare.Text@@ -103,6 +105,7 @@ default: False test-suite test+ default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs other-modules: Text.Shakespeare.BaseSpec