From 0509d4383c328c20be61cf3e3bbc98a0a1161588 Mon Sep 17 00:00:00 2001 From: dummy Date: Thu, 16 Oct 2014 02:21:17 +0000 Subject: [PATCH] hack TH --- 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 9500ecb..ec8471a 100644 --- a/Text/Hamlet.hs +++ b/Text/Hamlet.hs @@ -11,36 +11,36 @@ module Text.Hamlet ( -- * Plain HTML Html - , shamlet - , shamletFile - , xshamlet - , xshamletFile + --, shamlet + --, shamletFile + --, xshamlet + --, xshamletFile -- * Hamlet , HtmlUrl - , hamlet - , hamletFile - , hamletFileReload - , ihamletFileReload - , xhamlet - , xhamletFile + --, hamlet + --, hamletFile + --, hamletFileReload + --, ihamletFileReload + --, xhamlet + --, xhamletFile -- * I18N Hamlet , HtmlUrlI18n - , ihamlet - , ihamletFile + --, ihamlet + --, ihamletFile -- * Type classes , ToAttributes (..) -- * Internal, for making more , HamletSettings (..) , NewlineStyle (..) - , hamletWithSettings - , hamletFileWithSettings + --, hamletWithSettings + --, hamletFileWithSettings , defaultHamletSettings , xhtmlHamletSettings - , Env (..) - , HamletRules (..) - , hamletRules - , ihamletRules - , htmlRules + --, Env (..) + --, HamletRules (..) + --, hamletRules + --, ihamletRules + --, htmlRules , CloseStyle (..) -- * Used by generated code , condH @@ -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 -docsToExp :: Env -> HamletRules -> Scope -> [Doc] -> Q Exp -docsToExp env hr scope docs = do - exps <- mapM (docToExp env hr scope) docs - case exps of - [] -> [|return ()|] - [x] -> return x - _ -> return $ DoE $ map NoBindS exps - unIdent :: Ident -> String unIdent (Ident s) = s -bindingPattern :: Binding -> Q (Pat, [(Ident, Exp)]) -bindingPattern (BindAs i@(Ident s) b) = do - name <- newName s - (pattern, scope) <- bindingPattern b - return (AsP name pattern, (i, VarE name):scope) -bindingPattern (BindVar i@(Ident s)) - | all isDigit s = do - return (LitP $ IntegerL $ read s, []) - | otherwise = do - name <- newName s - return (VarP name, [(i, VarE name)]) -bindingPattern (BindTuple is) = do - (patterns, scopes) <- fmap unzip $ mapM bindingPattern is - return (TupP patterns, concat scopes) -bindingPattern (BindList is) = do - (patterns, scopes) <- fmap unzip $ mapM bindingPattern is - return (ListP patterns, concat scopes) -bindingPattern (BindConstr con is) = do - (patterns, scopes) <- fmap unzip $ mapM bindingPattern is - return (ConP (mkConName con) patterns, concat scopes) -bindingPattern (BindRecord con fields wild) = do - let f (Ident field,b) = - do (p,s) <- bindingPattern b - return ((mkName field,p),s) - (patterns, scopes) <- fmap unzip $ mapM f fields - (patterns1, scopes1) <- if wild - then bindWildFields con $ map fst fields - else return ([],[]) - return (RecP (mkConName con) (patterns++patterns1), concat scopes ++ scopes1) - mkConName :: DataConstr -> Name mkConName = mkName . conToStr @@ -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. -- @@ -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|] @@ -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 -- 2.1.1