refreshed patches
This commit is contained in:
Joey Hess
parent
d51d0a344f
commit
92aadb2865
9 changed files with 501 additions and 663 deletions
|
|
@ -1,17 +1,18 @@
|
|||
From f500a9e447912e68c12f011fe97b62e6a6c5c3ce Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 17 Dec 2013 16:16:32 +0000
|
||||
From 60d7ac8aa1b3282a06ea7b17680dfc32c61fcbf6 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Thu, 6 Mar 2014 23:19:40 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Hamlet.hs | 310 ++++-----------------------------------------------------
|
||||
1 file changed, 17 insertions(+), 293 deletions(-)
|
||||
Text/Hamlet.hs | 86 +++++++++++++++++-----------------------------------
|
||||
Text/Hamlet/Parse.hs | 3 +-
|
||||
2 files changed, 29 insertions(+), 60 deletions(-)
|
||||
|
||||
diff --git a/Text/Hamlet.hs b/Text/Hamlet.hs
|
||||
index 4f873f4..10d8ba6 100644
|
||||
index 9500ecb..ec8471a 100644
|
||||
--- a/Text/Hamlet.hs
|
||||
+++ b/Text/Hamlet.hs
|
||||
@@ -11,34 +11,34 @@
|
||||
@@ -11,36 +11,36 @@
|
||||
module Text.Hamlet
|
||||
( -- * Plain HTML
|
||||
Html
|
||||
|
|
@ -27,10 +28,14 @@ index 4f873f4..10d8ba6 100644
|
|||
, HtmlUrl
|
||||
- , hamlet
|
||||
- , hamletFile
|
||||
- , hamletFileReload
|
||||
- , ihamletFileReload
|
||||
- , xhamlet
|
||||
- , xhamletFile
|
||||
+ --, hamlet
|
||||
+ --, hamletFile
|
||||
+ --, hamletFileReload
|
||||
+ --, ihamletFileReload
|
||||
+ --, xhamlet
|
||||
+ --, xhamletFile
|
||||
-- * I18N Hamlet
|
||||
|
|
@ -63,7 +68,7 @@ index 4f873f4..10d8ba6 100644
|
|||
, CloseStyle (..)
|
||||
-- * Used by generated code
|
||||
, condH
|
||||
@@ -100,47 +100,9 @@ type HtmlUrl url = Render url -> Html
|
||||
@@ -110,47 +110,9 @@ type HtmlUrl url = Render url -> Html
|
||||
-- | A function generating an 'Html' given a message translator and a URL rendering function.
|
||||
type HtmlUrlI18n msg url = Translate msg -> Render url -> Html
|
||||
|
||||
|
|
@ -111,255 +116,90 @@ index 4f873f4..10d8ba6 100644
|
|||
mkConName :: DataConstr -> Name
|
||||
mkConName = mkName . conToStr
|
||||
|
||||
@@ -148,248 +110,10 @@ conToStr :: DataConstr -> String
|
||||
@@ -158,6 +120,7 @@ conToStr :: DataConstr -> String
|
||||
conToStr (DCUnqualified (Ident x)) = x
|
||||
conToStr (DCQualified (Module xs) (Ident x)) = intercalate "." $ xs ++ [x]
|
||||
|
||||
--- Wildcards bind all of the unbound fields to variables whose name
|
||||
--- matches the field name.
|
||||
---
|
||||
--- For example: data R = C { f1, f2 :: Int }
|
||||
--- C {..} is equivalent to C {f1=f1, f2=f2}
|
||||
--- C {f1 = a, ..} is equivalent to C {f1=a, f2=f2}
|
||||
--- C {f2 = a, ..} is equivalent to C {f1=f1, f2=a}
|
||||
-bindWildFields :: DataConstr -> [Ident] -> Q ([(Name, Pat)], [(Ident, Exp)])
|
||||
-bindWildFields conName fields = do
|
||||
- fieldNames <- recordToFieldNames conName
|
||||
- let available n = nameBase n `notElem` map unIdent fields
|
||||
- let remainingFields = filter available fieldNames
|
||||
- let mkPat n = do
|
||||
- e <- newName (nameBase n)
|
||||
- return ((n,VarP e), (Ident (nameBase n), VarE e))
|
||||
- fmap unzip $ mapM mkPat remainingFields
|
||||
-
|
||||
--- Important note! reify will fail if the record type is defined in the
|
||||
--- same module as the reify is used. This means quasi-quoted Hamlet
|
||||
--- literals will not be able to use wildcards to match record types
|
||||
--- defined in the same module.
|
||||
-recordToFieldNames :: DataConstr -> Q [Name]
|
||||
-recordToFieldNames conStr = do
|
||||
- -- use 'lookupValueName' instead of just using 'mkName' so we reify the
|
||||
- -- data constructor and not the type constructor if their names match.
|
||||
- Just conName <- lookupValueName $ conToStr conStr
|
||||
- DataConI _ _ typeName _ <- reify conName
|
||||
- TyConI (DataD _ _ _ cons _) <- reify typeName
|
||||
- [fields] <- return [fields | RecC name fields <- cons, name == conName]
|
||||
- return [fieldName | (fieldName, _, _) <- fields]
|
||||
-
|
||||
-docToExp :: Env -> HamletRules -> Scope -> Doc -> Q Exp
|
||||
-docToExp env hr scope (DocForall list idents inside) = do
|
||||
- let list' = derefToExp scope list
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- mh <- [|F.mapM_|]
|
||||
- inside' <- docsToExp env hr scope' inside
|
||||
- let lam = LamE [pat] inside'
|
||||
- return $ mh `AppE` lam `AppE` list'
|
||||
-docToExp env hr scope (DocWith [] inside) = do
|
||||
- inside' <- docsToExp env hr scope inside
|
||||
- return $ inside'
|
||||
-docToExp env hr scope (DocWith ((deref, idents):dis) inside) = do
|
||||
- let deref' = derefToExp scope deref
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- inside' <- docToExp env hr scope' (DocWith dis inside)
|
||||
- let lam = LamE [pat] inside'
|
||||
- return $ lam `AppE` deref'
|
||||
-docToExp env hr scope (DocMaybe val idents inside mno) = do
|
||||
- let val' = derefToExp scope val
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- inside' <- docsToExp env hr scope' inside
|
||||
- let inside'' = LamE [pat] inside'
|
||||
- ninside' <- case mno of
|
||||
- Nothing -> [|Nothing|]
|
||||
- Just no -> do
|
||||
- no' <- docsToExp env hr scope no
|
||||
- j <- [|Just|]
|
||||
- return $ j `AppE` no'
|
||||
- mh <- [|maybeH|]
|
||||
- return $ mh `AppE` val' `AppE` inside'' `AppE` ninside'
|
||||
-docToExp env hr scope (DocCond conds final) = do
|
||||
- conds' <- mapM go conds
|
||||
- final' <- case final of
|
||||
- Nothing -> [|Nothing|]
|
||||
- Just f -> do
|
||||
- f' <- docsToExp env hr scope f
|
||||
- j <- [|Just|]
|
||||
- return $ j `AppE` f'
|
||||
- ch <- [|condH|]
|
||||
- return $ ch `AppE` ListE conds' `AppE` final'
|
||||
- where
|
||||
- go :: (Deref, [Doc]) -> Q Exp
|
||||
- go (d, docs) = do
|
||||
- let d' = derefToExp ((specialOrIdent, VarE 'or):scope) d
|
||||
- docs' <- docsToExp env hr scope docs
|
||||
- return $ TupE [d', docs']
|
||||
-docToExp env hr scope (DocCase deref cases) = do
|
||||
- let exp_ = derefToExp scope deref
|
||||
- matches <- mapM toMatch cases
|
||||
- return $ CaseE exp_ matches
|
||||
- where
|
||||
- readMay s =
|
||||
- case reads s of
|
||||
- (x, ""):_ -> Just x
|
||||
- _ -> Nothing
|
||||
- toMatch :: (Binding, [Doc]) -> Q Match
|
||||
- toMatch (idents, inside) = do
|
||||
- (pat, extraScope) <- bindingPattern idents
|
||||
- let scope' = extraScope ++ scope
|
||||
- insideExp <- docsToExp env hr scope' inside
|
||||
- return $ Match pat (NormalB insideExp) []
|
||||
-docToExp env hr v (DocContent c) = contentToExp env hr v c
|
||||
-
|
||||
-contentToExp :: Env -> HamletRules -> Scope -> Content -> Q Exp
|
||||
-contentToExp _ hr _ (ContentRaw s) = do
|
||||
- os <- [|preEscapedText . pack|]
|
||||
- let s' = LitE $ StringL s
|
||||
- return $ hrFromHtml hr `AppE` (os `AppE` s')
|
||||
-contentToExp _ hr scope (ContentVar d) = do
|
||||
- str <- [|toHtml|]
|
||||
- return $ hrFromHtml hr `AppE` (str `AppE` derefToExp scope d)
|
||||
-contentToExp env hr scope (ContentUrl hasParams d) =
|
||||
- case urlRender env of
|
||||
- Nothing -> error "URL interpolation used, but no URL renderer provided"
|
||||
- Just wrender -> wrender $ \render -> do
|
||||
- let render' = return render
|
||||
- ou <- if hasParams
|
||||
- then [|\(u, p) -> $(render') u p|]
|
||||
- else [|\u -> $(render') u []|]
|
||||
- let d' = derefToExp scope d
|
||||
- pet <- [|toHtml|]
|
||||
- return $ hrFromHtml hr `AppE` (pet `AppE` (ou `AppE` d'))
|
||||
-contentToExp env hr scope (ContentEmbed d) = hrEmbed hr env $ derefToExp scope d
|
||||
-contentToExp env hr scope (ContentMsg d) =
|
||||
- case msgRender env of
|
||||
- Nothing -> error "Message interpolation used, but no message renderer provided"
|
||||
- Just wrender -> wrender $ \render ->
|
||||
- return $ hrFromHtml hr `AppE` (render `AppE` derefToExp scope d)
|
||||
-contentToExp _ hr scope (ContentAttrs d) = do
|
||||
- html <- [|attrsToHtml . toAttributes|]
|
||||
- return $ hrFromHtml hr `AppE` (html `AppE` derefToExp scope d)
|
||||
-
|
||||
-shamlet :: QuasiQuoter
|
||||
-shamlet = hamletWithSettings htmlRules defaultHamletSettings
|
||||
-
|
||||
-xshamlet :: QuasiQuoter
|
||||
-xshamlet = hamletWithSettings htmlRules xhtmlHamletSettings
|
||||
-
|
||||
-htmlRules :: Q HamletRules
|
||||
-htmlRules = do
|
||||
- i <- [|id|]
|
||||
- return $ HamletRules i ($ (Env Nothing Nothing)) (\_ b -> return b)
|
||||
-
|
||||
-hamlet :: QuasiQuoter
|
||||
-hamlet = hamletWithSettings hamletRules defaultHamletSettings
|
||||
-
|
||||
-xhamlet :: QuasiQuoter
|
||||
-xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
|
||||
+{-
|
||||
-- Wildcards bind all of the unbound fields to variables whose name
|
||||
-- matches the field name.
|
||||
--
|
||||
@@ -296,10 +259,12 @@ hamlet = hamletWithSettings hamletRules defaultHamletSettings
|
||||
|
||||
xhamlet :: QuasiQuoter
|
||||
xhamlet = hamletWithSettings hamletRules xhtmlHamletSettings
|
||||
+-}
|
||||
|
||||
asHtmlUrl :: HtmlUrl url -> HtmlUrl url
|
||||
asHtmlUrl = id
|
||||
|
||||
-hamletRules :: Q HamletRules
|
||||
-hamletRules = do
|
||||
- i <- [|id|]
|
||||
- let ur f = do
|
||||
- r <- newName "_render"
|
||||
- let env = Env
|
||||
- { urlRender = Just ($ (VarE r))
|
||||
- , msgRender = Nothing
|
||||
- }
|
||||
- h <- f env
|
||||
- return $ LamE [VarP r] h
|
||||
- return $ HamletRules i ur em
|
||||
- where
|
||||
- em (Env (Just urender) Nothing) e = do
|
||||
- asHtmlUrl' <- [|asHtmlUrl|]
|
||||
- urender $ \ur' -> return ((asHtmlUrl' `AppE` e) `AppE` ur')
|
||||
- em _ _ = error "bad Env"
|
||||
-
|
||||
-ihamlet :: QuasiQuoter
|
||||
-ihamlet = hamletWithSettings ihamletRules defaultHamletSettings
|
||||
-
|
||||
-ihamletRules :: Q HamletRules
|
||||
-ihamletRules = do
|
||||
- i <- [|id|]
|
||||
- let ur f = do
|
||||
- u <- newName "_urender"
|
||||
- m <- newName "_mrender"
|
||||
- let env = Env
|
||||
- { urlRender = Just ($ (VarE u))
|
||||
- , msgRender = Just ($ (VarE m))
|
||||
- }
|
||||
- h <- f env
|
||||
- return $ LamE [VarP m, VarP u] h
|
||||
- return $ HamletRules i ur em
|
||||
- where
|
||||
- em (Env (Just urender) (Just mrender)) e =
|
||||
- urender $ \ur' -> mrender $ \mr -> return (e `AppE` mr `AppE` ur')
|
||||
- em _ _ = error "bad Env"
|
||||
-
|
||||
-hamletWithSettings :: Q HamletRules -> HamletSettings -> QuasiQuoter
|
||||
-hamletWithSettings hr set =
|
||||
- QuasiQuoter
|
||||
- { quoteExp = hamletFromString hr set
|
||||
- }
|
||||
-
|
||||
-data HamletRules = HamletRules
|
||||
- { hrFromHtml :: Exp
|
||||
- , hrWithEnv :: (Env -> Q Exp) -> Q Exp
|
||||
- , hrEmbed :: Env -> Exp -> Q Exp
|
||||
- }
|
||||
-
|
||||
-data Env = Env
|
||||
- { urlRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
|
||||
- , msgRender :: Maybe ((Exp -> Q Exp) -> Q Exp)
|
||||
- }
|
||||
-
|
||||
-hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
|
||||
-hamletFromString qhr set s = do
|
||||
- hr <- qhr
|
||||
- case parseDoc set s of
|
||||
- Error s' -> error s'
|
||||
- Ok (_mnl, d) -> hrWithEnv hr $ \env -> docsToExp env hr [] d
|
||||
-
|
||||
-hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
|
||||
-hamletFileWithSettings qhr set fp = do
|
||||
-#ifdef GHC_7_4
|
||||
- qAddDependentFile fp
|
||||
-#endif
|
||||
- contents <- fmap TL.unpack $ qRunIO $ readUtf8File fp
|
||||
- hamletFromString qhr set contents
|
||||
-
|
||||
-hamletFile :: FilePath -> Q Exp
|
||||
-hamletFile = hamletFileWithSettings hamletRules defaultHamletSettings
|
||||
-
|
||||
-xhamletFile :: FilePath -> Q Exp
|
||||
-xhamletFile = hamletFileWithSettings hamletRules xhtmlHamletSettings
|
||||
-
|
||||
-shamletFile :: FilePath -> Q Exp
|
||||
-shamletFile = hamletFileWithSettings htmlRules defaultHamletSettings
|
||||
-
|
||||
-xshamletFile :: FilePath -> Q Exp
|
||||
-xshamletFile = hamletFileWithSettings htmlRules xhtmlHamletSettings
|
||||
-
|
||||
-ihamletFile :: FilePath -> Q Exp
|
||||
-ihamletFile = hamletFileWithSettings ihamletRules defaultHamletSettings
|
||||
-
|
||||
-varName :: Scope -> String -> Exp
|
||||
-varName _ "" = error "Illegal empty varName"
|
||||
-varName scope v@(_:_) = fromMaybe (strToExp v) $ lookup (Ident v) scope
|
||||
-
|
||||
-strToExp :: String -> Exp
|
||||
-strToExp s@(c:_)
|
||||
- | all isDigit s = LitE $ IntegerL $ read s
|
||||
- | isUpper c = ConE $ mkName s
|
||||
- | otherwise = VarE $ mkName s
|
||||
-strToExp "" = error "strToExp on empty string"
|
||||
+{-
|
||||
hamletRules :: Q HamletRules
|
||||
hamletRules = do
|
||||
i <- [|id|]
|
||||
@@ -360,6 +325,7 @@ hamletFromString :: Q HamletRules -> HamletSettings -> String -> Q Exp
|
||||
hamletFromString qhr set s = do
|
||||
hr <- qhr
|
||||
hrWithEnv hr $ \env -> docsToExp env hr [] $ docFromString set s
|
||||
+-}
|
||||
|
||||
docFromString :: HamletSettings -> String -> [Doc]
|
||||
docFromString set s =
|
||||
@@ -367,6 +333,7 @@ docFromString set s =
|
||||
Error s' -> error s'
|
||||
Ok (_, d) -> d
|
||||
|
||||
+{-
|
||||
hamletFileWithSettings :: Q HamletRules -> HamletSettings -> FilePath -> Q Exp
|
||||
hamletFileWithSettings qhr set fp = do
|
||||
#ifdef GHC_7_4
|
||||
@@ -408,6 +375,7 @@ strToExp s@(c:_)
|
||||
| isUpper c = ConE $ mkName s
|
||||
| otherwise = VarE $ mkName s
|
||||
strToExp "" = error "strToExp on empty string"
|
||||
+-}
|
||||
|
||||
-- | Checks for truth in the left value in each pair in the first argument. If
|
||||
-- a true exists, then the corresponding right action is performed. Only the
|
||||
@@ -452,7 +420,7 @@ hamletUsedIdentifiers settings =
|
||||
data HamletRuntimeRules = HamletRuntimeRules {
|
||||
hrrI18n :: Bool
|
||||
}
|
||||
-
|
||||
+{-
|
||||
hamletFileReloadWithSettings :: HamletRuntimeRules
|
||||
-> HamletSettings -> FilePath -> Q Exp
|
||||
hamletFileReloadWithSettings hrr settings fp = do
|
||||
@@ -479,7 +447,7 @@ hamletFileReloadWithSettings hrr settings fp = do
|
||||
c VTUrlParam = [|EUrlParam|]
|
||||
c VTMixin = [|\r -> EMixin $ \c -> r c|]
|
||||
c VTMsg = [|EMsg|]
|
||||
-
|
||||
+-}
|
||||
-- move to Shakespeare.Base?
|
||||
readFileUtf8 :: FilePath -> IO String
|
||||
readFileUtf8 fp = fmap TL.unpack $ readUtf8File fp
|
||||
diff --git a/Text/Hamlet/Parse.hs b/Text/Hamlet/Parse.hs
|
||||
index b7e2954..1f14946 100644
|
||||
--- a/Text/Hamlet/Parse.hs
|
||||
+++ b/Text/Hamlet/Parse.hs
|
||||
@@ -616,6 +616,7 @@ data NewlineStyle = NoNewlines -- ^ never add newlines
|
||||
| DefaultNewlineStyle
|
||||
deriving Show
|
||||
|
||||
+{-
|
||||
instance Lift NewlineStyle where
|
||||
lift NoNewlines = [|NoNewlines|]
|
||||
lift NewlinesText = [|NewlinesText|]
|
||||
@@ -627,7 +628,7 @@ instance Lift (String -> CloseStyle) where
|
||||
|
||||
instance Lift HamletSettings where
|
||||
lift (HamletSettings a b c d) = [|HamletSettings $(lift a) $(lift b) $(lift c) $(lift d)|]
|
||||
-
|
||||
+-}
|
||||
|
||||
htmlEmptyTags :: Set String
|
||||
htmlEmptyTags = Set.fromAscList
|
||||
--
|
||||
1.8.5.1
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,20 +1,21 @@
|
|||
From b9b3cd52735f9ede1a83960968dc1f0e91e061d6 Mon Sep 17 00:00:00 2001
|
||||
From 66fdbc0cb69036b61552a3bce7e995ea2a7f76c1 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 7 Feb 2014 21:49:11 +0000
|
||||
Subject: [PATCH] avoid TH
|
||||
Date: Fri, 7 Mar 2014 05:43:33 +0000
|
||||
Subject: [PATCH] TH
|
||||
|
||||
---
|
||||
lens.cabal | 14 +-------------
|
||||
src/Control/Lens.hs | 6 ++----
|
||||
src/Control/Lens/Cons.hs | 2 --
|
||||
src/Control/Lens/Internal/Fold.hs | 2 --
|
||||
src/Control/Lens/Internal/Reflection.hs | 2 --
|
||||
src/Control/Lens/Prism.hs | 2 --
|
||||
src/Control/Monad/Primitive/Lens.hs | 1 -
|
||||
7 files changed, 3 insertions(+), 26 deletions(-)
|
||||
lens.cabal | 19 +------------------
|
||||
src/Control/Lens.hs | 8 ++------
|
||||
src/Control/Lens/Cons.hs | 2 --
|
||||
src/Control/Lens/Internal/Fold.hs | 2 --
|
||||
src/Control/Lens/Internal/Reflection.hs | 2 --
|
||||
src/Control/Lens/Operators.hs | 2 +-
|
||||
src/Control/Lens/Prism.hs | 2 --
|
||||
src/Control/Monad/Primitive/Lens.hs | 1 -
|
||||
8 files changed, 4 insertions(+), 34 deletions(-)
|
||||
|
||||
diff --git a/lens.cabal b/lens.cabal
|
||||
index cee2da7..1e467c4 100644
|
||||
index 790a9d7..7cd3ff9 100644
|
||||
--- a/lens.cabal
|
||||
+++ b/lens.cabal
|
||||
@@ -10,7 +10,7 @@ stability: provisional
|
||||
|
|
@ -26,7 +27,15 @@ index cee2da7..1e467c4 100644
|
|||
-- build-tools: cpphs
|
||||
tested-with: GHC == 7.6.3
|
||||
synopsis: Lenses, Folds and Traversals
|
||||
@@ -216,7 +216,6 @@ library
|
||||
@@ -177,7 +177,6 @@ flag lib-Werror
|
||||
|
||||
library
|
||||
build-depends:
|
||||
- aeson >= 0.7 && < 0.8,
|
||||
array >= 0.3.0.2 && < 0.6,
|
||||
base >= 4.3 && < 5,
|
||||
bifunctors >= 4 && < 5,
|
||||
@@ -216,7 +215,6 @@ library
|
||||
Control.Exception.Lens
|
||||
Control.Lens
|
||||
Control.Lens.Action
|
||||
|
|
@ -34,7 +43,12 @@ index cee2da7..1e467c4 100644
|
|||
Control.Lens.Combinators
|
||||
Control.Lens.Cons
|
||||
Control.Lens.Each
|
||||
@@ -256,17 +255,14 @@ library
|
||||
@@ -251,22 +249,18 @@ library
|
||||
Control.Lens.Level
|
||||
Control.Lens.Loupe
|
||||
Control.Lens.Operators
|
||||
- Control.Lens.Plated
|
||||
Control.Lens.Prism
|
||||
Control.Lens.Reified
|
||||
Control.Lens.Review
|
||||
Control.Lens.Setter
|
||||
|
|
@ -52,7 +66,7 @@ index cee2da7..1e467c4 100644
|
|||
Data.Array.Lens
|
||||
Data.Bits.Lens
|
||||
Data.ByteString.Lens
|
||||
@@ -289,12 +285,8 @@ library
|
||||
@@ -289,17 +283,10 @@ library
|
||||
Data.Typeable.Lens
|
||||
Data.Vector.Lens
|
||||
Data.Vector.Generic.Lens
|
||||
|
|
@ -64,8 +78,13 @@ index cee2da7..1e467c4 100644
|
|||
- Language.Haskell.TH.Lens
|
||||
Numeric.Lens
|
||||
|
||||
other-modules:
|
||||
@@ -394,7 +386,6 @@ test-suite doctests
|
||||
- other-modules:
|
||||
- Control.Lens.Internal.TupleIxedTH
|
||||
-
|
||||
if flag(safe)
|
||||
cpp-options: -DSAFE=1
|
||||
|
||||
@@ -396,7 +383,6 @@ test-suite doctests
|
||||
deepseq,
|
||||
doctest >= 0.9.1,
|
||||
filepath,
|
||||
|
|
@ -73,7 +92,7 @@ index cee2da7..1e467c4 100644
|
|||
mtl,
|
||||
nats,
|
||||
parallel,
|
||||
@@ -432,7 +423,6 @@ benchmark plated
|
||||
@@ -434,7 +420,6 @@ benchmark plated
|
||||
comonad,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
|
@ -81,7 +100,7 @@ index cee2da7..1e467c4 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -467,7 +457,6 @@ benchmark unsafe
|
||||
@@ -469,7 +454,6 @@ benchmark unsafe
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
|
@ -89,7 +108,7 @@ index cee2da7..1e467c4 100644
|
|||
lens,
|
||||
transformers
|
||||
|
||||
@@ -484,6 +473,5 @@ benchmark zipper
|
||||
@@ -486,6 +470,5 @@ benchmark zipper
|
||||
comonads-fd,
|
||||
criterion,
|
||||
deepseq,
|
||||
|
|
@ -97,7 +116,7 @@ index cee2da7..1e467c4 100644
|
|||
lens,
|
||||
transformers
|
||||
diff --git a/src/Control/Lens.hs b/src/Control/Lens.hs
|
||||
index 7e15267..bb4d87b 100644
|
||||
index 7e15267..433f1fc 100644
|
||||
--- a/src/Control/Lens.hs
|
||||
+++ b/src/Control/Lens.hs
|
||||
@@ -41,7 +41,6 @@
|
||||
|
|
@ -108,7 +127,12 @@ index 7e15267..bb4d87b 100644
|
|||
, module Control.Lens.Cons
|
||||
, module Control.Lens.Each
|
||||
, module Control.Lens.Empty
|
||||
@@ -58,7 +57,7 @@ module Control.Lens
|
||||
@@ -53,12 +52,11 @@ module Control.Lens
|
||||
, module Control.Lens.Lens
|
||||
, module Control.Lens.Level
|
||||
, module Control.Lens.Loupe
|
||||
- , module Control.Lens.Plated
|
||||
, module Control.Lens.Prism
|
||||
, module Control.Lens.Reified
|
||||
, module Control.Lens.Review
|
||||
, module Control.Lens.Setter
|
||||
|
|
@ -117,7 +141,7 @@ index 7e15267..bb4d87b 100644
|
|||
, module Control.Lens.TH
|
||||
#endif
|
||||
, module Control.Lens.Traversal
|
||||
@@ -69,7 +68,6 @@ module Control.Lens
|
||||
@@ -69,7 +67,6 @@ module Control.Lens
|
||||
) where
|
||||
|
||||
import Control.Lens.Action
|
||||
|
|
@ -125,7 +149,12 @@ index 7e15267..bb4d87b 100644
|
|||
import Control.Lens.Cons
|
||||
import Control.Lens.Each
|
||||
import Control.Lens.Empty
|
||||
@@ -86,7 +84,7 @@ import Control.Lens.Prism
|
||||
@@ -81,12 +78,11 @@ import Control.Lens.Iso
|
||||
import Control.Lens.Lens
|
||||
import Control.Lens.Level
|
||||
import Control.Lens.Loupe
|
||||
-import Control.Lens.Plated
|
||||
import Control.Lens.Prism
|
||||
import Control.Lens.Reified
|
||||
import Control.Lens.Review
|
||||
import Control.Lens.Setter
|
||||
|
|
@ -148,7 +177,7 @@ index a80e9c8..7d27b80 100644
|
|||
-- >>> :set -XNoOverloadedStrings
|
||||
-- >>> import Control.Lens
|
||||
diff --git a/src/Control/Lens/Internal/Fold.hs b/src/Control/Lens/Internal/Fold.hs
|
||||
index 00e4b66..03c9cd2 100644
|
||||
index ab09c6b..43aa905 100644
|
||||
--- a/src/Control/Lens/Internal/Fold.hs
|
||||
+++ b/src/Control/Lens/Internal/Fold.hs
|
||||
@@ -37,8 +37,6 @@ import Data.Maybe
|
||||
|
|
@ -173,6 +202,19 @@ index bf09f2c..c9e112f 100644
|
|||
class Typeable s => B s where
|
||||
reflectByte :: proxy s -> IntPtr
|
||||
|
||||
diff --git a/src/Control/Lens/Operators.hs b/src/Control/Lens/Operators.hs
|
||||
index 3e14c55..989eb92 100644
|
||||
--- a/src/Control/Lens/Operators.hs
|
||||
+++ b/src/Control/Lens/Operators.hs
|
||||
@@ -110,7 +110,7 @@ module Control.Lens.Operators
|
||||
, (<#~)
|
||||
, (<#=)
|
||||
-- * "Control.Lens.Plated"
|
||||
- , (...)
|
||||
+ --, (...)
|
||||
-- * "Control.Lens.Review"
|
||||
, ( # )
|
||||
-- * "Control.Lens.Setter"
|
||||
diff --git a/src/Control/Lens/Prism.hs b/src/Control/Lens/Prism.hs
|
||||
index 9e0bec7..0cf6737 100644
|
||||
--- a/src/Control/Lens/Prism.hs
|
||||
|
|
@ -199,5 +241,5 @@ index ee942c6..2f37134 100644
|
|||
prim :: (PrimMonad m) => Iso' (m a) (State# (PrimState m) -> (# State# (PrimState m), a #))
|
||||
prim = iso internal primitive
|
||||
--
|
||||
1.7.10.4
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,150 +1,27 @@
|
|||
From 08aa9d495cb486c45998dfad95518c646b5fa8cc Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 17 Dec 2013 16:24:31 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
From 8e78a25ce0cc19e52d063f66bd4cd316462393d4 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Thu, 6 Mar 2014 23:27:06 +0000
|
||||
Subject: [PATCH] disable th
|
||||
|
||||
---
|
||||
Control/Monad/Logger.hs | 109 ++++++++++--------------------------------------
|
||||
1 file changed, 21 insertions(+), 88 deletions(-)
|
||||
monad-logger.cabal | 4 ++--
|
||||
1 file changed, 2 insertions(+), 2 deletions(-)
|
||||
|
||||
diff --git a/Control/Monad/Logger.hs b/Control/Monad/Logger.hs
|
||||
index be756d7..d4979f8 100644
|
||||
--- a/Control/Monad/Logger.hs
|
||||
+++ b/Control/Monad/Logger.hs
|
||||
@@ -31,31 +31,31 @@ module Control.Monad.Logger
|
||||
, withChannelLogger
|
||||
, NoLoggingT (..)
|
||||
-- * TH logging
|
||||
- , logDebug
|
||||
- , logInfo
|
||||
- , logWarn
|
||||
- , logError
|
||||
- , logOther
|
||||
+ --, logDebug
|
||||
+ --, logInfo
|
||||
+ --, logWarn
|
||||
+ --, logError
|
||||
+ --, logOther
|
||||
-- * TH logging with source
|
||||
- , logDebugS
|
||||
- , logInfoS
|
||||
- , logWarnS
|
||||
- , logErrorS
|
||||
- , logOtherS
|
||||
+ --, logDebugS
|
||||
+ --, logInfoS
|
||||
+ --, logWarnS
|
||||
+ --, logErrorS
|
||||
+ --, logOtherS
|
||||
-- * TH util
|
||||
- , liftLoc
|
||||
+ -- , liftLoc
|
||||
-- * Non-TH logging
|
||||
- , logDebugN
|
||||
- , logInfoN
|
||||
- , logWarnN
|
||||
- , logErrorN
|
||||
- , logOtherN
|
||||
+ --, logDebugN
|
||||
+ --, logInfoN
|
||||
+ --, logWarnN
|
||||
+ --, logErrorN
|
||||
+ --, logOtherN
|
||||
-- * Non-TH logging with source
|
||||
- , logDebugNS
|
||||
- , logInfoNS
|
||||
- , logWarnNS
|
||||
- , logErrorNS
|
||||
- , logOtherNS
|
||||
+ --, logDebugNS
|
||||
+ --, logInfoNS
|
||||
+ --, logWarnNS
|
||||
+ --, logErrorNS
|
||||
+ --, logOtherNS
|
||||
) where
|
||||
diff --git a/monad-logger.cabal b/monad-logger.cabal
|
||||
index b0aa271..cd56c0f 100644
|
||||
--- a/monad-logger.cabal
|
||||
+++ b/monad-logger.cabal
|
||||
@@ -14,8 +14,8 @@ cabal-version: >=1.8
|
||||
|
||||
import Language.Haskell.TH.Syntax (Lift (lift), Q, Exp, Loc (..), qLocation)
|
||||
@@ -115,13 +115,6 @@ import Control.Monad.Writer.Class ( MonadWriter (..) )
|
||||
data LogLevel = LevelDebug | LevelInfo | LevelWarn | LevelError | LevelOther Text
|
||||
deriving (Eq, Prelude.Show, Prelude.Read, Ord)
|
||||
flag template_haskell {
|
||||
Description: Enable Template Haskell support
|
||||
- Default: True
|
||||
- Manual: True
|
||||
+ Default: False
|
||||
+ Manual: False
|
||||
}
|
||||
|
||||
-instance Lift LogLevel where
|
||||
- lift LevelDebug = [|LevelDebug|]
|
||||
- lift LevelInfo = [|LevelInfo|]
|
||||
- lift LevelWarn = [|LevelWarn|]
|
||||
- lift LevelError = [|LevelError|]
|
||||
- lift (LevelOther x) = [|LevelOther $ pack $(lift $ unpack x)|]
|
||||
-
|
||||
type LogSource = Text
|
||||
|
||||
class Monad m => MonadLogger m where
|
||||
@@ -152,66 +145,6 @@ instance (MonadLogger m, Monoid w) => MonadLogger (Strict.WriterT w m) where DEF
|
||||
instance (MonadLogger m, Monoid w) => MonadLogger (Strict.RWST r w s m) where DEF
|
||||
#undef DEF
|
||||
|
||||
-logTH :: LogLevel -> Q Exp
|
||||
-logTH level =
|
||||
- [|monadLoggerLog $(qLocation >>= liftLoc) (pack "") $(lift level) . (id :: Text -> Text)|]
|
||||
-
|
||||
--- | Generates a function that takes a 'Text' and logs a 'LevelDebug' message. Usage:
|
||||
---
|
||||
--- > $(logDebug) "This is a debug log message"
|
||||
-logDebug :: Q Exp
|
||||
-logDebug = logTH LevelDebug
|
||||
-
|
||||
--- | See 'logDebug'
|
||||
-logInfo :: Q Exp
|
||||
-logInfo = logTH LevelInfo
|
||||
--- | See 'logDebug'
|
||||
-logWarn :: Q Exp
|
||||
-logWarn = logTH LevelWarn
|
||||
--- | See 'logDebug'
|
||||
-logError :: Q Exp
|
||||
-logError = logTH LevelError
|
||||
-
|
||||
--- | Generates a function that takes a 'Text' and logs a 'LevelOther' message. Usage:
|
||||
---
|
||||
--- > $(logOther "My new level") "This is a log message"
|
||||
-logOther :: Text -> Q Exp
|
||||
-logOther = logTH . LevelOther
|
||||
-
|
||||
--- | Lift a location into an Exp.
|
||||
---
|
||||
--- Since 0.3.1
|
||||
-liftLoc :: Loc -> Q Exp
|
||||
-liftLoc (Loc a b c (d1, d2) (e1, e2)) = [|Loc
|
||||
- $(lift a)
|
||||
- $(lift b)
|
||||
- $(lift c)
|
||||
- ($(lift d1), $(lift d2))
|
||||
- ($(lift e1), $(lift e2))
|
||||
- |]
|
||||
-
|
||||
--- | Generates a function that takes a 'LogSource' and 'Text' and logs a 'LevelDebug' message. Usage:
|
||||
---
|
||||
--- > $logDebugS "SomeSource" "This is a debug log message"
|
||||
-logDebugS :: Q Exp
|
||||
-logDebugS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelDebug (b :: Text)|]
|
||||
-
|
||||
--- | See 'logDebugS'
|
||||
-logInfoS :: Q Exp
|
||||
-logInfoS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelInfo (b :: Text)|]
|
||||
--- | See 'logDebugS'
|
||||
-logWarnS :: Q Exp
|
||||
-logWarnS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelWarn (b :: Text)|]
|
||||
--- | See 'logDebugS'
|
||||
-logErrorS :: Q Exp
|
||||
-logErrorS = [|\a b -> monadLoggerLog $(qLocation >>= liftLoc) a LevelError (b :: Text)|]
|
||||
-
|
||||
--- | Generates a function that takes a 'LogSource', a level name and a 'Text' and logs a 'LevelOther' message. Usage:
|
||||
---
|
||||
--- > $logOtherS "SomeSource" "My new level" "This is a log message"
|
||||
-logOtherS :: Q Exp
|
||||
-logOtherS = [|\src level msg -> monadLoggerLog $(qLocation >>= liftLoc) src (LevelOther level) (msg :: Text)|]
|
||||
-
|
||||
-- | Monad transformer that disables logging.
|
||||
--
|
||||
-- Since 0.2.4
|
||||
library
|
||||
--
|
||||
1.8.5.1
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
From 22c68b43dce437b3c22956f5a968f1b886e60e0c Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 17 Dec 2013 19:15:16 +0000
|
||||
From c0f5dcfd6ba7a05bb84b6adc4664c8dde109e6ac Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 7 Mar 2014 04:30:22 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
fast/Data/Reflection.hs | 80 +------------------------------------------------
|
||||
1 file changed, 1 insertion(+), 79 deletions(-)
|
||||
fast/Data/Reflection.hs | 8 +++++---
|
||||
1 file changed, 5 insertions(+), 3 deletions(-)
|
||||
|
||||
diff --git a/fast/Data/Reflection.hs b/fast/Data/Reflection.hs
|
||||
index 119d773..cf99efa 100644
|
||||
index ca57d35..d3f8356 100644
|
||||
--- a/fast/Data/Reflection.hs
|
||||
+++ b/fast/Data/Reflection.hs
|
||||
@@ -58,7 +58,7 @@ module Data.Reflection
|
||||
@@ -59,7 +59,7 @@ module Data.Reflection
|
||||
, Given(..)
|
||||
, give
|
||||
-- * Template Haskell reflection
|
||||
|
|
@ -20,94 +20,40 @@ index 119d773..cf99efa 100644
|
|||
-- * Useful compile time naturals
|
||||
, Z, D, SD, PD
|
||||
) where
|
||||
@@ -151,87 +151,9 @@ instance Reifies n Int => Reifies (PD n) Int where
|
||||
reflect = (\n -> n + n - 1) <$> retagPD reflect
|
||||
{-# INLINE reflect #-}
|
||||
@@ -161,6 +161,7 @@ instance Reifies n Int => Reifies (PD n) Int where
|
||||
-- instead of @$(int 3)@. Sometimes the two will produce the same
|
||||
-- representation (if compiled without the @-DUSE_TYPE_LITS@ preprocessor
|
||||
-- directive).
|
||||
+{-
|
||||
int :: Int -> TypeQ
|
||||
int n = case quotRem n 2 of
|
||||
(0, 0) -> conT ''Z
|
||||
@@ -176,7 +177,7 @@ nat :: Int -> TypeQ
|
||||
nat n
|
||||
| n >= 0 = int n
|
||||
| otherwise = error "nat: negative"
|
||||
-
|
||||
+-}
|
||||
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704
|
||||
instance Show (Q a)
|
||||
instance Eq (Q a)
|
||||
@@ -195,6 +196,7 @@ instance Fractional a => Fractional (Q a) where
|
||||
recip = fmap recip
|
||||
fromRational = return . fromRational
|
||||
|
||||
--- | This can be used to generate a template haskell splice for a type level version of a given 'int'.
|
||||
---
|
||||
--- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used
|
||||
--- in the \"Functional Pearl: Implicit Configurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.
|
||||
-int :: Int -> TypeQ
|
||||
-int n = case quotRem n 2 of
|
||||
- (0, 0) -> conT ''Z
|
||||
- (q,-1) -> conT ''PD `appT` int q
|
||||
- (q, 0) -> conT ''D `appT` int q
|
||||
- (q, 1) -> conT ''SD `appT` int q
|
||||
- _ -> error "ghc is bad at math"
|
||||
+{-
|
||||
-- | This permits the use of $(5) as a type splice.
|
||||
instance Num Type where
|
||||
#ifdef USE_TYPE_LITS
|
||||
@@ -254,7 +256,7 @@ instance Num Exp where
|
||||
abs = onProxyType1 abs
|
||||
signum = onProxyType1 signum
|
||||
fromInteger n = ConE 'Proxy `SigE` (ConT ''Proxy `AppT` fromInteger n)
|
||||
-
|
||||
--- | This is a restricted version of 'int' that can only generate natural numbers. Attempting to generate
|
||||
--- a negative number results in a compile time error. Also the resulting sequence will consist entirely of
|
||||
--- Z, D, and SD constructors representing the number in zeroless binary.
|
||||
-nat :: Int -> TypeQ
|
||||
-nat n
|
||||
- | n >= 0 = int n
|
||||
- | otherwise = error "nat: negative"
|
||||
-
|
||||
-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL < 704
|
||||
-instance Show (Q a)
|
||||
-instance Eq (Q a)
|
||||
-#endif
|
||||
-instance Num a => Num (Q a) where
|
||||
- (+) = liftM2 (+)
|
||||
- (*) = liftM2 (*)
|
||||
- (-) = liftM2 (-)
|
||||
- negate = fmap negate
|
||||
- abs = fmap abs
|
||||
- signum = fmap signum
|
||||
- fromInteger = return . fromInteger
|
||||
-
|
||||
-instance Fractional a => Fractional (Q a) where
|
||||
- (/) = liftM2 (/)
|
||||
- recip = fmap recip
|
||||
- fromRational = return . fromRational
|
||||
-
|
||||
--- | This permits the use of $(5) as a type splice.
|
||||
-instance Num Type where
|
||||
-#ifdef USE_TYPE_LITS
|
||||
- a + b = AppT (AppT (VarT ''(+)) a) b
|
||||
- a * b = AppT (AppT (VarT ''(*)) a) b
|
||||
-#if MIN_VERSION_base(4,8,0)
|
||||
- a - b = AppT (AppT (VarT ''(-)) a) b
|
||||
-#else
|
||||
- (-) = error "Type.(-): undefined"
|
||||
-#endif
|
||||
- fromInteger = LitT . NumTyLit
|
||||
-#else
|
||||
- (+) = error "Type.(+): undefined"
|
||||
- (*) = error "Type.(*): undefined"
|
||||
- (-) = error "Type.(-): undefined"
|
||||
- fromInteger n = case quotRem n 2 of
|
||||
- (0, 0) -> ConT ''Z
|
||||
- (q,-1) -> ConT ''PD `AppT` fromInteger q
|
||||
- (q, 0) -> ConT ''D `AppT` fromInteger q
|
||||
- (q, 1) -> ConT ''SD `AppT` fromInteger q
|
||||
- _ -> error "ghc is bad at math"
|
||||
-#endif
|
||||
- abs = error "Type.abs"
|
||||
- signum = error "Type.signum"
|
||||
-
|
||||
plus, times, minus :: Num a => a -> a -> a
|
||||
plus = (+)
|
||||
times = (*)
|
||||
minus = (-)
|
||||
fract :: Fractional a => a -> a -> a
|
||||
fract = (/)
|
||||
-
|
||||
--- | This permits the use of $(5) as an expression splice.
|
||||
-instance Num Exp where
|
||||
- a + b = AppE (AppE (VarE 'plus) a) b
|
||||
- a * b = AppE (AppE (VarE 'times) a) b
|
||||
- a - b = AppE (AppE (VarE 'minus) a) b
|
||||
- negate = AppE (VarE 'negate)
|
||||
- signum = AppE (VarE 'signum)
|
||||
- abs = AppE (VarE 'abs)
|
||||
- fromInteger = LitE . IntegerL
|
||||
-
|
||||
-instance Fractional Exp where
|
||||
- a / b = AppE (AppE (VarE 'fract) a) b
|
||||
- recip = AppE (VarE 'recip)
|
||||
- fromRational = LitE . RationalL
|
||||
+-}
|
||||
#ifdef USE_TYPE_LITS
|
||||
addProxy :: Proxy a -> Proxy b -> Proxy (a + b)
|
||||
addProxy _ _ = Proxy
|
||||
--
|
||||
1.8.5.1
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,26 +0,0 @@
|
|||
From 4a75a2f0d77168aa3115b991284a5120484e18f0 Mon Sep 17 00:00:00 2001
|
||||
From: foo <foo@bar>
|
||||
Date: Sun, 22 Sep 2013 04:59:21 +0000
|
||||
Subject: [PATCH] TH exports
|
||||
|
||||
---
|
||||
Text/Shakespeare.hs | 3 +++
|
||||
1 file changed, 3 insertions(+)
|
||||
|
||||
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
|
||||
index 9eb06a2..1290ab1 100644
|
||||
--- a/Text/Shakespeare.hs
|
||||
+++ b/Text/Shakespeare.hs
|
||||
@@ -23,6 +23,9 @@ module Text.Shakespeare
|
||||
, Deref
|
||||
, Parser
|
||||
|
||||
+ -- used by TH
|
||||
+ , pack'
|
||||
+
|
||||
#ifdef TEST_EXPORT
|
||||
, preFilter
|
||||
#endif
|
||||
--
|
||||
1.7.10.4
|
||||
|
||||
|
|
@ -1,39 +1,44 @@
|
|||
From b66f160fea86d8839572620892181eb4ada2ad29 Mon Sep 17 00:00:00 2001
|
||||
From 753f8ce37e096a343f1dd02a696a287bc91c24a0 Mon Sep 17 00:00:00 2001
|
||||
From: Joey Hess <joey@kitenet.net>
|
||||
Date: Tue, 17 Dec 2013 06:17:26 +0000
|
||||
Subject: [PATCH 2/2] remove TH
|
||||
Date: Thu, 6 Mar 2014 22:34:03 +0000
|
||||
Subject: [PATCH] remove TH
|
||||
|
||||
---
|
||||
Text/Shakespeare.hs | 131 +++--------------------------------------------
|
||||
Text/Shakespeare/Base.hs | 28 ----------
|
||||
2 files changed, 6 insertions(+), 153 deletions(-)
|
||||
Text/Shakespeare.hs | 73 ++++++++++--------------------------------------
|
||||
Text/Shakespeare/Base.hs | 28 -------------------
|
||||
2 files changed, 14 insertions(+), 87 deletions(-)
|
||||
|
||||
diff --git a/Text/Shakespeare.hs b/Text/Shakespeare.hs
|
||||
index f908ff4..55cd1d1 100644
|
||||
index 68e344f..aef741c 100644
|
||||
--- a/Text/Shakespeare.hs
|
||||
+++ b/Text/Shakespeare.hs
|
||||
@@ -12,14 +12,14 @@ module Text.Shakespeare
|
||||
@@ -14,17 +14,20 @@ module Text.Shakespeare
|
||||
, WrapInsertion (..)
|
||||
, PreConversion (..)
|
||||
, defaultShakespeareSettings
|
||||
- , shakespeare
|
||||
- , shakespeareFile
|
||||
- , shakespeareFileReload
|
||||
+ --, shakespeare
|
||||
+ --, shakespeareFile
|
||||
+ -- , shakespeare
|
||||
+ -- , shakespeareFile
|
||||
+ -- , shakespeareFileReload
|
||||
-- * low-level
|
||||
- , shakespeareFromString
|
||||
- , shakespeareUsedIdentifiers
|
||||
+ -- , shakespeareFromString
|
||||
+ --, shakespeareUsedIdentifiers
|
||||
+ -- , shakespeareUsedIdentifiers
|
||||
, RenderUrl
|
||||
- , VarType
|
||||
+ --, VarType
|
||||
, VarType (..)
|
||||
, Deref
|
||||
, Parser
|
||||
|
||||
@@ -151,38 +151,6 @@ defaultShakespeareSettings = ShakespeareSettings {
|
||||
+ -- used by TH
|
||||
+ , pack'
|
||||
+
|
||||
#ifdef TEST_EXPORT
|
||||
, preFilter
|
||||
#endif
|
||||
@@ -154,38 +157,6 @@ defaultShakespeareSettings = ShakespeareSettings {
|
||||
, modifyFinalValue = Nothing
|
||||
}
|
||||
|
||||
|
|
@ -72,85 +77,46 @@ index f908ff4..55cd1d1 100644
|
|||
|
||||
type QueryParameters = [(TS.Text, TS.Text)]
|
||||
type RenderUrl url = (url -> QueryParameters -> TS.Text)
|
||||
@@ -346,77 +314,12 @@ pack' = TS.pack
|
||||
@@ -349,6 +320,7 @@ pack' = TS.pack
|
||||
{-# NOINLINE pack' #-}
|
||||
#endif
|
||||
|
||||
-contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
|
||||
-contentsToShakespeare rs a = do
|
||||
- r <- newName "_render"
|
||||
- c <- mapM (contentToBuilder r) a
|
||||
- compiledTemplate <- case c of
|
||||
- -- Make sure we convert this mempty using toBuilder to pin down the
|
||||
- -- type appropriately
|
||||
- [] -> fmap (AppE $ wrap rs) [|mempty|]
|
||||
- [x] -> return x
|
||||
- _ -> do
|
||||
- mc <- [|mconcat|]
|
||||
- return $ mc `AppE` ListE c
|
||||
- fmap (maybe id AppE $ modifyFinalValue rs) $
|
||||
- if justVarInterpolation rs
|
||||
- then return compiledTemplate
|
||||
- else return $ LamE [VarP r] compiledTemplate
|
||||
- where
|
||||
- contentToBuilder :: Name -> Content -> Q Exp
|
||||
- contentToBuilder _ (ContentRaw s') = do
|
||||
- ts <- [|fromText . pack'|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` LitE (StringL s'))
|
||||
- contentToBuilder _ (ContentVar d) =
|
||||
- return $ (toBuilder rs `AppE` derefToExp [] d)
|
||||
- contentToBuilder r (ContentUrl d) = do
|
||||
- ts <- [|fromText|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` (VarE r `AppE` derefToExp [] d `AppE` ListE []))
|
||||
- contentToBuilder r (ContentUrlParam d) = do
|
||||
- ts <- [|fromText|]
|
||||
- up <- [|\r' (u, p) -> r' u p|]
|
||||
- return $ wrap rs `AppE` (ts `AppE` (up `AppE` VarE r `AppE` derefToExp [] d))
|
||||
- contentToBuilder r (ContentMix d) =
|
||||
- return $ derefToExp [] d `AppE` VarE r
|
||||
-
|
||||
-shakespeare :: ShakespeareSettings -> QuasiQuoter
|
||||
-shakespeare r = QuasiQuoter { quoteExp = shakespeareFromString r }
|
||||
-
|
||||
-shakespeareFromString :: ShakespeareSettings -> String -> Q Exp
|
||||
-shakespeareFromString r str = do
|
||||
- s <- qRunIO $ preFilter Nothing r $
|
||||
-#ifdef WINDOWS
|
||||
- filter (/='\r')
|
||||
-#endif
|
||||
- str
|
||||
- contentsToShakespeare r $ contentFromString r s
|
||||
-
|
||||
-shakespeareFile :: ShakespeareSettings -> FilePath -> Q Exp
|
||||
-shakespeareFile r fp = do
|
||||
-#ifdef GHC_7_4
|
||||
- qAddDependentFile fp
|
||||
-#endif
|
||||
- readFileQ fp >>= shakespeareFromString r
|
||||
-
|
||||
-data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
|
||||
-
|
||||
-getVars :: Content -> [(Deref, VarType)]
|
||||
-getVars ContentRaw{} = []
|
||||
-getVars (ContentVar d) = [(d, VTPlain)]
|
||||
-getVars (ContentUrl d) = [(d, VTUrl)]
|
||||
-getVars (ContentUrlParam d) = [(d, VTUrlParam)]
|
||||
-getVars (ContentMix d) = [(d, VTMixin)]
|
||||
+{-
|
||||
contentsToShakespeare :: ShakespeareSettings -> [Content] -> Q Exp
|
||||
contentsToShakespeare rs a = do
|
||||
r <- newName "_render"
|
||||
@@ -400,16 +372,19 @@ shakespeareFile r fp =
|
||||
qAddDependentFile fp >>
|
||||
#endif
|
||||
readFileQ fp >>= shakespeareFromString r
|
||||
+-}
|
||||
|
||||
data VarType = VTPlain | VTUrl | VTUrlParam | VTMixin
|
||||
deriving (Show, Eq, Ord, Enum, Bounded, Typeable, Data, Generic)
|
||||
|
||||
+{-
|
||||
getVars :: Content -> [(Deref, VarType)]
|
||||
getVars ContentRaw{} = []
|
||||
getVars (ContentVar d) = [(d, VTPlain)]
|
||||
getVars (ContentUrl d) = [(d, VTUrl)]
|
||||
getVars (ContentUrlParam d) = [(d, VTUrlParam)]
|
||||
getVars (ContentMix d) = [(d, VTMixin)]
|
||||
+-}
|
||||
|
||||
data VarExp url = EPlain Builder
|
||||
| EUrl url
|
||||
| EUrlParam (url, [(TS.Text, TS.Text)])
|
||||
| EMixin (Shakespeare url)
|
||||
@@ -418,8 +393,10 @@ data VarExp url = EPlain Builder
|
||||
|
||||
-- | Determine which identifiers are used by the given template, useful for
|
||||
-- creating systems like yesod devel.
|
||||
+{-
|
||||
shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
|
||||
shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
|
||||
+-}
|
||||
|
||||
--- | Determine which identifiers are used by the given template, useful for
|
||||
--- creating systems like yesod devel.
|
||||
-shakespeareUsedIdentifiers :: ShakespeareSettings -> String -> [(Deref, VarType)]
|
||||
-shakespeareUsedIdentifiers settings = concatMap getVars . contentFromString settings
|
||||
-
|
||||
type MTime = UTCTime
|
||||
|
||||
{-# NOINLINE reloadMapRef #-}
|
||||
@@ -432,28 +335,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
|
||||
@@ -436,28 +413,6 @@ insertReloadMap :: FilePath -> (MTime, [Content]) -> IO [Content]
|
||||
insertReloadMap fp (mt, content) = atomicModifyIORef reloadMapRef
|
||||
(\reloadMap -> (M.insert fp (mt, content) reloadMap, content))
|
||||
|
||||
|
|
@ -180,7 +146,7 @@ index f908ff4..55cd1d1 100644
|
|||
|
||||
|
||||
diff --git a/Text/Shakespeare/Base.hs b/Text/Shakespeare/Base.hs
|
||||
index 9573533..49f1995 100644
|
||||
index a0e983c..23b4692 100644
|
||||
--- a/Text/Shakespeare/Base.hs
|
||||
+++ b/Text/Shakespeare/Base.hs
|
||||
@@ -52,34 +52,6 @@ data Deref = DerefModulesIdent [String] Ident
|
||||
|
|
@ -219,5 +185,5 @@ index 9573533..49f1995 100644
|
|||
derefParens = between (char '(') (char ')') parseDeref
|
||||
derefCurlyBrackets = between (char '{') (char '}') parseDeref
|
||||
--
|
||||
1.8.5.1
|
||||
1.9.0
|
||||
|
||||
|
|
@ -1,17 +1,19 @@
|
|||
From 5f30a68faaa379ac3fe9f0b016dd1a20969d548f Mon Sep 17 00:00:00 2001
|
||||
From be8d5895522da0397fd594d5553ed7d3641eb399 Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 7 Feb 2014 23:04:06 +0000
|
||||
Date: Fri, 7 Mar 2014 01:40:29 +0000
|
||||
Subject: [PATCH] remove and expand TH
|
||||
|
||||
fix Loc from MonadLogger
|
||||
---
|
||||
Yesod/Core.hs | 30 +++---
|
||||
Yesod/Core/Class/Yesod.hs | 248 ++++++++++++++++++++++++++++++--------------
|
||||
Yesod/Core/Dispatch.hs | 37 ++-----
|
||||
Yesod/Core/Handler.hs | 25 ++---
|
||||
Yesod/Core/Internal/Run.hs | 4 +-
|
||||
Yesod/Core/Internal/TH.hs | 111 --------------------
|
||||
Yesod/Core/Widget.hs | 32 +-----
|
||||
7 files changed, 209 insertions(+), 278 deletions(-)
|
||||
Yesod/Core.hs | 30 +++---
|
||||
Yesod/Core/Class/Yesod.hs | 257 ++++++++++++++++++++++++++++++---------------
|
||||
Yesod/Core/Dispatch.hs | 37 ++-----
|
||||
Yesod/Core/Handler.hs | 25 ++---
|
||||
Yesod/Core/Internal/Run.hs | 8 +-
|
||||
Yesod/Core/Internal/TH.hs | 111 --------------------
|
||||
Yesod/Core/Types.hs | 3 +-
|
||||
Yesod/Core/Widget.hs | 32 +-----
|
||||
8 files changed, 215 insertions(+), 288 deletions(-)
|
||||
|
||||
diff --git a/Yesod/Core.hs b/Yesod/Core.hs
|
||||
index 12e59d5..2817a69 100644
|
||||
|
|
@ -67,10 +69,10 @@ index 12e59d5..2817a69 100644
|
|||
, renderCssUrl
|
||||
) where
|
||||
diff --git a/Yesod/Core/Class/Yesod.hs b/Yesod/Core/Class/Yesod.hs
|
||||
index 140600b..6c718e2 100644
|
||||
index 140600b..75daabc 100644
|
||||
--- a/Yesod/Core/Class/Yesod.hs
|
||||
+++ b/Yesod/Core/Class/Yesod.hs
|
||||
@@ -5,11 +5,15 @@
|
||||
@@ -5,18 +5,22 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
module Yesod.Core.Class.Yesod where
|
||||
|
||||
|
|
@ -87,7 +89,23 @@ index 140600b..6c718e2 100644
|
|||
|
||||
import Blaze.ByteString.Builder (Builder)
|
||||
import Blaze.ByteString.Builder.Char.Utf8 (fromText)
|
||||
@@ -94,18 +98,27 @@ class RenderRoute site => Yesod site where
|
||||
import Control.Arrow ((***), second)
|
||||
import Control.Monad (forM, when, void)
|
||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||
-import Control.Monad.Logger (LogLevel (LevelInfo, LevelOther),
|
||||
+import Control.Monad.Logger (Loc, LogLevel (LevelInfo, LevelOther),
|
||||
LogSource)
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
import qualified Data.ByteString.Lazy as L
|
||||
@@ -33,7 +37,6 @@ import qualified Data.Text.Encoding.Error as TEE
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Encoding (encodeUtf8)
|
||||
import Data.Word (Word64)
|
||||
-import Language.Haskell.TH.Syntax (Loc (..))
|
||||
import Network.HTTP.Types (encodePath)
|
||||
import qualified Network.Wai as W
|
||||
import Data.Default (def)
|
||||
@@ -94,18 +97,27 @@ class RenderRoute site => Yesod site where
|
||||
defaultLayout w = do
|
||||
p <- widgetToPageContent w
|
||||
mmsg <- getMessage
|
||||
|
|
@ -127,7 +145,7 @@ index 140600b..6c718e2 100644
|
|||
|
||||
-- | Override the rendering function for a particular URL. One use case for
|
||||
-- this is to offload static hosting to a different domain name to avoid
|
||||
@@ -374,45 +387,103 @@ widgetToPageContent w = do
|
||||
@@ -374,45 +386,103 @@ widgetToPageContent w = do
|
||||
-- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
|
||||
-- the asynchronous loader means your page doesn't have to wait for all the js to load
|
||||
let (mcomplete, asyncScripts) = asyncHelper render scripts jscript jsLoc
|
||||
|
|
@ -270,7 +288,7 @@ index 140600b..6c718e2 100644
|
|||
|
||||
return $ PageContent title headAll $
|
||||
case jsLoader master of
|
||||
@@ -442,10 +513,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
@@ -442,10 +512,13 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
r <- waiRequest
|
||||
let path' = TE.decodeUtf8With TEE.lenientDecode $ W.rawPathInfo r
|
||||
setTitle "Not Found"
|
||||
|
|
@ -288,7 +306,7 @@ index 140600b..6c718e2 100644
|
|||
provideRep $ return $ object ["message" .= ("Not Found" :: Text)]
|
||||
|
||||
-- For API requests.
|
||||
@@ -455,10 +529,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
@@ -455,10 +528,11 @@ defaultErrorHandler NotFound = selectRep $ do
|
||||
defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Not logged in"
|
||||
|
|
@ -304,7 +322,7 @@ index 140600b..6c718e2 100644
|
|||
|
||||
provideRep $ do
|
||||
-- 401 *MUST* include a WWW-Authenticate header
|
||||
@@ -480,10 +555,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
@@ -480,10 +554,13 @@ defaultErrorHandler NotAuthenticated = selectRep $ do
|
||||
defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Permission Denied"
|
||||
|
|
@ -322,7 +340,7 @@ index 140600b..6c718e2 100644
|
|||
provideRep $
|
||||
return $ object $ [
|
||||
"message" .= ("Permission Denied. " <> msg)
|
||||
@@ -492,30 +570,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
@@ -492,30 +569,42 @@ defaultErrorHandler (PermissionDenied msg) = selectRep $ do
|
||||
defaultErrorHandler (InvalidArgs ia) = selectRep $ do
|
||||
provideRep $ defaultLayout $ do
|
||||
setTitle "Invalid Arguments"
|
||||
|
|
@ -380,6 +398,16 @@ index 140600b..6c718e2 100644
|
|||
provideRep $ return $ object ["message" .= ("Bad method" :: Text), "method" .= TE.decodeUtf8With TEE.lenientDecode m]
|
||||
|
||||
asyncHelper :: (url -> [x] -> Text)
|
||||
@@ -682,8 +771,4 @@ loadClientSession key getCachedDate sessionName req = load
|
||||
-- turn the TH Loc loaction information into a human readable string
|
||||
-- leaving out the loc_end parameter
|
||||
fileLocationToString :: Loc -> String
|
||||
-fileLocationToString loc = (loc_package loc) ++ ':' : (loc_module loc) ++
|
||||
- ' ' : (loc_filename loc) ++ ':' : (line loc) ++ ':' : (char loc)
|
||||
- where
|
||||
- line = show . fst . loc_start
|
||||
- char = show . snd . loc_start
|
||||
+fileLocationToString loc = "unknown"
|
||||
diff --git a/Yesod/Core/Dispatch.hs b/Yesod/Core/Dispatch.hs
|
||||
index e6f489d..3ff37c1 100644
|
||||
--- a/Yesod/Core/Dispatch.hs
|
||||
|
|
@ -506,18 +534,29 @@ index 7c561c5..847d475 100644
|
|||
-- | Wraps the 'Content' generated by 'hamletToContent' in a 'RepHtml'.
|
||||
hamletToRepHtml :: MonadHandler m => HtmlUrl (Route (HandlerSite m)) -> m Html
|
||||
diff --git a/Yesod/Core/Internal/Run.hs b/Yesod/Core/Internal/Run.hs
|
||||
index 10871a2..6ed631e 100644
|
||||
index 10871a2..e8d1907 100644
|
||||
--- a/Yesod/Core/Internal/Run.hs
|
||||
+++ b/Yesod/Core/Internal/Run.hs
|
||||
@@ -16,7 +16,7 @@ import Control.Exception.Lifted (catch)
|
||||
@@ -15,8 +15,8 @@ import qualified Control.Exception as E
|
||||
import Control.Exception.Lifted (catch)
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import Control.Monad.IO.Class (liftIO)
|
||||
import Control.Monad.Logger (LogLevel (LevelError), LogSource,
|
||||
-import Control.Monad.Logger (LogLevel (LevelError), LogSource,
|
||||
- liftLoc)
|
||||
+import Control.Monad.Logger (Loc, LogLevel (LevelError), LogSource,
|
||||
+ )
|
||||
import Control.Monad.Trans.Resource (runResourceT, withInternalState, runInternalState, createInternalState, closeInternalState)
|
||||
import qualified Data.ByteString as S
|
||||
import qualified Data.ByteString.Char8 as S8
|
||||
@@ -30,7 +30,7 @@ import qualified Data.Text as T
|
||||
import Data.Text.Encoding (encodeUtf8)
|
||||
import Data.Text.Encoding (decodeUtf8With)
|
||||
import Data.Text.Encoding.Error (lenientDecode)
|
||||
-import Language.Haskell.TH.Syntax (Loc, qLocation)
|
||||
+import Language.Haskell.TH.Syntax (qLocation)
|
||||
import qualified Network.HTTP.Types as H
|
||||
import Network.Wai
|
||||
#if MIN_VERSION_wai(2, 0, 0)
|
||||
@@ -131,8 +131,6 @@ safeEh :: (Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
-> ErrorResponse
|
||||
-> YesodApp
|
||||
|
|
@ -646,6 +685,27 @@ index 7e84c1c..a273c29 100644
|
|||
- [innerFun]
|
||||
- ]
|
||||
- return $ LetE [fun] (VarE helper)
|
||||
diff --git a/Yesod/Core/Types.hs b/Yesod/Core/Types.hs
|
||||
index de09f78..9183a64 100644
|
||||
--- a/Yesod/Core/Types.hs
|
||||
+++ b/Yesod/Core/Types.hs
|
||||
@@ -17,6 +17,7 @@ import Control.Exception (Exception)
|
||||
import Control.Monad (liftM, ap)
|
||||
import Control.Monad.Base (MonadBase (liftBase))
|
||||
import Control.Monad.IO.Class (MonadIO (liftIO))
|
||||
+import qualified Control.Monad.Logger
|
||||
import Control.Monad.Logger (LogLevel, LogSource,
|
||||
MonadLogger (..))
|
||||
import Control.Monad.Trans.Control (MonadBaseControl (..))
|
||||
@@ -179,7 +180,7 @@ data RunHandlerEnv site = RunHandlerEnv
|
||||
, rheRoute :: !(Maybe (Route site))
|
||||
, rheSite :: !site
|
||||
, rheUpload :: !(RequestBodyLength -> FileUpload)
|
||||
- , rheLog :: !(Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
+ , rheLog :: !(Control.Monad.Logger.Loc -> LogSource -> LogLevel -> LogStr -> IO ())
|
||||
, rheOnError :: !(ErrorResponse -> YesodApp)
|
||||
-- ^ How to respond when an error is thrown internally.
|
||||
--
|
||||
diff --git a/Yesod/Core/Widget.hs b/Yesod/Core/Widget.hs
|
||||
index a972efa..156cd45 100644
|
||||
--- a/Yesod/Core/Widget.hs
|
||||
|
|
@ -707,5 +767,5 @@ index a972efa..156cd45 100644
|
|||
ihamletToRepHtml :: (MonadHandler m, RenderMessage (HandlerSite m) message)
|
||||
=> HtmlUrlI18n message (Route (HandlerSite m))
|
||||
--
|
||||
1.7.10.4
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,17 +1,17 @@
|
|||
From 4ea1e94794b59ba4eb0dab7384c4195a224f468d Mon Sep 17 00:00:00 2001
|
||||
From: androidbuilder <androidbuilder@example.com>
|
||||
Date: Fri, 27 Dec 2013 00:28:51 -0400
|
||||
From 885cc873196f535de7cd1ac2ccfa217d10308d1f Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Fri, 7 Mar 2014 02:28:34 +0000
|
||||
Subject: [PATCH] avoid building with jsmin
|
||||
|
||||
jsmin needs language-javascript, which fails to build for android due to
|
||||
a problem or incompatability with happy.
|
||||
|
||||
This also avoids all the TH code.
|
||||
|
||||
---
|
||||
Yesod/EmbeddedStatic/Generators.hs | 3 +--
|
||||
yesod-static.cabal | 7 -------
|
||||
2 files changed, 1 insertion(+), 9 deletions(-)
|
||||
Yesod/EmbeddedStatic/Generators.hs | 3 +--
|
||||
Yesod/Static.hs | 29 ++++++++++++++++++-----------
|
||||
yesod-static.cabal | 7 -------
|
||||
3 files changed, 19 insertions(+), 20 deletions(-)
|
||||
|
||||
diff --git a/Yesod/EmbeddedStatic/Generators.hs b/Yesod/EmbeddedStatic/Generators.hs
|
||||
index e83785d..6b1c10e 100644
|
||||
|
|
@ -34,8 +34,132 @@ index e83785d..6b1c10e 100644
|
|||
|
||||
-- | Use <https://github.com/mishoo/UglifyJS2 UglifyJS2> to compress javascript.
|
||||
-- Assumes @uglifyjs@ is located in the path and uses options @[\"-m\", \"-c\"]@
|
||||
diff --git a/Yesod/Static.hs b/Yesod/Static.hs
|
||||
index dd21791..37f7e00 100644
|
||||
--- a/Yesod/Static.hs
|
||||
+++ b/Yesod/Static.hs
|
||||
@@ -37,8 +37,8 @@ module Yesod.Static
|
||||
, staticDevel
|
||||
-- * Combining CSS/JS
|
||||
-- $combining
|
||||
- , combineStylesheets'
|
||||
- , combineScripts'
|
||||
+ --, combineStylesheets'
|
||||
+ --, combineScripts'
|
||||
-- ** Settings
|
||||
, CombineSettings
|
||||
, csStaticDir
|
||||
@@ -48,13 +48,13 @@ module Yesod.Static
|
||||
, csJsPreProcess
|
||||
, csCombinedFolder
|
||||
-- * Template Haskell helpers
|
||||
- , staticFiles
|
||||
- , staticFilesList
|
||||
- , publicFiles
|
||||
+ --, staticFiles
|
||||
+ --, staticFilesList
|
||||
+ --, publicFiles
|
||||
-- * Hashing
|
||||
, base64md5
|
||||
-- * Embed
|
||||
- , embed
|
||||
+ --, embed
|
||||
#ifdef TEST_EXPORT
|
||||
, getFileListPieces
|
||||
#endif
|
||||
@@ -64,7 +64,7 @@ import Prelude hiding (FilePath)
|
||||
import qualified Prelude
|
||||
import System.Directory
|
||||
import Control.Monad
|
||||
-import Data.FileEmbed (embedDir)
|
||||
+import Data.FileEmbed
|
||||
|
||||
import Yesod.Core
|
||||
import Yesod.Core.Types
|
||||
@@ -135,6 +135,7 @@ staticDevel dir = do
|
||||
hashLookup <- cachedETagLookupDevel dir
|
||||
return $ Static $ webAppSettingsWithLookup (F.decodeString dir) hashLookup
|
||||
|
||||
+{-
|
||||
-- | Produce a 'Static' based on embedding all of the static files' contents in the
|
||||
-- executable at compile time.
|
||||
--
|
||||
@@ -149,6 +150,7 @@ staticDevel dir = do
|
||||
-- This will cause yesod to embed those assets into the generated HTML file itself.
|
||||
embed :: Prelude.FilePath -> Q Exp
|
||||
embed fp = [|Static (embeddedSettings $(embedDir fp))|]
|
||||
+-}
|
||||
|
||||
instance RenderRoute Static where
|
||||
-- | A route on the static subsite (see also 'staticFiles').
|
||||
@@ -214,6 +216,7 @@ getFileListPieces = flip evalStateT M.empty . flip go id
|
||||
put $ M.insert s s m
|
||||
return s
|
||||
|
||||
+{-
|
||||
-- | Template Haskell function that automatically creates routes
|
||||
-- for all of your static files.
|
||||
--
|
||||
@@ -266,7 +269,7 @@ staticFilesList dir fs =
|
||||
-- see if their copy is up-to-date.
|
||||
publicFiles :: Prelude.FilePath -> Q [Dec]
|
||||
publicFiles dir = mkStaticFiles' dir "StaticRoute" False
|
||||
-
|
||||
+-}
|
||||
|
||||
mkHashMap :: Prelude.FilePath -> IO (M.Map F.FilePath S8.ByteString)
|
||||
mkHashMap dir = do
|
||||
@@ -309,6 +312,7 @@ cachedETagLookup dir = do
|
||||
etags <- mkHashMap dir
|
||||
return $ (\f -> return $ M.lookup f etags)
|
||||
|
||||
+{-
|
||||
mkStaticFiles :: Prelude.FilePath -> Q [Dec]
|
||||
mkStaticFiles fp = mkStaticFiles' fp "StaticRoute" True
|
||||
|
||||
@@ -356,6 +360,7 @@ mkStaticFilesList fp fs routeConName makeHash = do
|
||||
[ Clause [] (NormalB $ (ConE route) `AppE` f' `AppE` qs) []
|
||||
]
|
||||
]
|
||||
+-}
|
||||
|
||||
base64md5File :: Prelude.FilePath -> IO String
|
||||
base64md5File = fmap (base64 . encode) . hashFile
|
||||
@@ -394,7 +399,7 @@ base64 = map tr
|
||||
-- single static file at compile time.
|
||||
|
||||
data CombineType = JS | CSS
|
||||
-
|
||||
+{-
|
||||
combineStatics' :: CombineType
|
||||
-> CombineSettings
|
||||
-> [Route Static] -- ^ files to combine
|
||||
@@ -428,7 +433,7 @@ combineStatics' combineType CombineSettings {..} routes = do
|
||||
case combineType of
|
||||
JS -> "js"
|
||||
CSS -> "css"
|
||||
-
|
||||
+-}
|
||||
-- | Data type for holding all settings for combining files.
|
||||
--
|
||||
-- This data type is a settings type. For more information, see:
|
||||
@@ -504,6 +509,7 @@ instance Default CombineSettings where
|
||||
errorIntro :: [FilePath] -> [Char] -> [Char]
|
||||
errorIntro fps s = "Error minifying " ++ show fps ++ ": " ++ s
|
||||
|
||||
+{-
|
||||
liftRoutes :: [Route Static] -> Q Exp
|
||||
liftRoutes =
|
||||
fmap ListE . mapM go
|
||||
@@ -550,4 +556,5 @@ combineScripts' :: Bool -- ^ development? if so, perform no combining
|
||||
-> Q Exp
|
||||
combineScripts' development cs con routes
|
||||
| development = [| mapM_ (addScript . $(return $ ConE con)) $(liftRoutes routes) |]
|
||||
- | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]
|
||||
+ | otherwise = [| addScript $ $(return $ ConE con) $(combineStatics' JS cs routes) |]a
|
||||
+-}
|
||||
diff --git a/yesod-static.cabal b/yesod-static.cabal
|
||||
index df05ecf..31abe1a 100644
|
||||
index 3423149..416aae6 100644
|
||||
--- a/yesod-static.cabal
|
||||
+++ b/yesod-static.cabal
|
||||
@@ -48,18 +48,12 @@ library
|
||||
|
|
@ -66,5 +190,5 @@ index df05ecf..31abe1a 100644
|
|||
, filepath
|
||||
, resourcet
|
||||
--
|
||||
1.7.10.4
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
|
|
@ -1,13 +1,13 @@
|
|||
From 69398345ff1e63bcc6a23fce18e42390328b78d2 Mon Sep 17 00:00:00 2001
|
||||
From 369c99b9de0c82578f5221fdabc42ea9ba59ddea Mon Sep 17 00:00:00 2001
|
||||
From: dummy <dummy@example.com>
|
||||
Date: Tue, 17 Dec 2013 18:48:56 +0000
|
||||
Subject: [PATCH] hack for TH
|
||||
Date: Fri, 7 Mar 2014 04:10:02 +0000
|
||||
Subject: [PATCH] hack to TH
|
||||
|
||||
---
|
||||
Yesod.hs | 19 ++++++++++++--
|
||||
Yesod/Default/Main.hs | 23 -----------------
|
||||
Yesod/Default/Util.hs | 69 ++-----------------------------------------------
|
||||
3 files changed, 19 insertions(+), 92 deletions(-)
|
||||
Yesod.hs | 19 ++++++++++++--
|
||||
Yesod/Default/Main.hs | 25 +------------------
|
||||
Yesod/Default/Util.hs | 69 ++-------------------------------------------------
|
||||
3 files changed, 20 insertions(+), 93 deletions(-)
|
||||
|
||||
diff --git a/Yesod.hs b/Yesod.hs
|
||||
index b367144..fbe309c 100644
|
||||
|
|
@ -41,7 +41,7 @@ index b367144..fbe309c 100644
|
|||
+insert = undefined
|
||||
+
|
||||
diff --git a/Yesod/Default/Main.hs b/Yesod/Default/Main.hs
|
||||
index 0780539..2c73800 100644
|
||||
index 0780539..ad99ccd 100644
|
||||
--- a/Yesod/Default/Main.hs
|
||||
+++ b/Yesod/Default/Main.hs
|
||||
@@ -1,10 +1,8 @@
|
||||
|
|
@ -55,6 +55,15 @@ index 0780539..2c73800 100644
|
|||
, defaultRunner
|
||||
, defaultDevelApp
|
||||
, LogFunc
|
||||
@@ -22,7 +20,7 @@ import Control.Monad (when)
|
||||
import System.Environment (getEnvironment)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Safe (readMay)
|
||||
-import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError), liftLoc)
|
||||
+import Control.Monad.Logger (Loc, LogSource, LogLevel (LevelError))
|
||||
import System.Log.FastLogger (LogStr, toLogStr)
|
||||
import Language.Haskell.TH.Syntax (qLocation)
|
||||
|
||||
@@ -54,27 +52,6 @@ defaultMain load getApp = do
|
||||
|
||||
type LogFunc = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
|
||||
|
|
@ -180,5 +189,5 @@ index a10358e..0547424 100644
|
|||
- else return $ Just ex
|
||||
- else return Nothing
|
||||
--
|
||||
1.7.10.4
|
||||
1.9.0
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue