diff options
Diffstat (limited to 'standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch')
| -rw-r--r-- | standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch | 215 |
1 files changed, 0 insertions, 215 deletions
diff --git a/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch b/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch deleted file mode 100644 index 3c6924039..000000000 --- a/standalone/no-th/haskell-patches/shakespeare-i18n_0001-remove-TH.patch +++ /dev/null @@ -1,215 +0,0 @@ -From 57ad7d1512a3144fd0b00f9796d5fd9e0ea86852 Mon Sep 17 00:00:00 2001 -From: Joey Hess <joey@kitenet.net> -Date: Tue, 17 Dec 2013 16:30:59 +0000 -Subject: [PATCH] remove TH - ---- - Text/Shakespeare/I18N.hs | 178 ++--------------------------------------------- - 1 file changed, 4 insertions(+), 174 deletions(-) - -diff --git a/Text/Shakespeare/I18N.hs b/Text/Shakespeare/I18N.hs -index 2077914..2289214 100644 ---- a/Text/Shakespeare/I18N.hs -+++ b/Text/Shakespeare/I18N.hs -@@ -51,10 +51,10 @@ - -- - -- You can also adapt those instructions for use with other systems. - module Text.Shakespeare.I18N -- ( mkMessage -- , mkMessageFor -- , mkMessageVariant -- , RenderMessage (..) -+ --( mkMessage -+ --, mkMessageFor -+ ---, mkMessageVariant -+ ( RenderMessage (..) - , ToMessage (..) - , SomeMessage (..) - , Lang -@@ -105,143 +105,6 @@ instance RenderMessage master Text where - -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc). - type Lang = Text - ---- |generate translations from translation files ---- ---- This function will: ---- ---- 1. look in the supplied subdirectory for files ending in @.msg@ ---- ---- 2. generate a type based on the constructors found ---- ---- 3. create a 'RenderMessage' instance ---- --mkMessage :: String -- ^ base name to use for translation type -- -> FilePath -- ^ subdirectory which contains the translation files -- -> Lang -- ^ default translation language -- -> Q [Dec] --mkMessage dt folder lang = -- mkMessageCommon True "Msg" "Message" dt dt folder lang -- -- ---- | create 'RenderMessage' instance for an existing data-type --mkMessageFor :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageFor master dt folder lang = mkMessageCommon False "" "" master dt folder lang -- ---- | create an additional set of translations for a type created by `mkMessage` --mkMessageVariant :: String -- ^ master translation data type -- -> String -- ^ existing type to add translations for -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default language -- -> Q [Dec] --mkMessageVariant master dt folder lang = mkMessageCommon False "Msg" "Message" master dt folder lang -- ---- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type --mkMessageCommon :: Bool -- ^ generate a new datatype from the constructors found in the .msg files -- -> String -- ^ string to append to constructor names -- -> String -- ^ string to append to datatype name -- -> String -- ^ base name of master datatype -- -> String -- ^ base name of translation datatype -- -> FilePath -- ^ path to translation folder -- -> Lang -- ^ default lang -- -> Q [Dec] --mkMessageCommon genType prefix postfix master dt folder lang = do -- files <- qRunIO $ getDirectoryContents folder -- (_files', contents) <- qRunIO $ fmap (unzip . catMaybes) $ mapM (loadLang folder) files --#ifdef GHC_7_4 -- mapM_ qAddDependentFile _files' --#endif -- sdef <- -- case lookup lang contents of -- Nothing -> error $ "Did not find main language file: " ++ unpack lang -- Just def -> toSDefs def -- mapM_ (checkDef sdef) $ map snd contents -- let mname = mkName $ dt ++ postfix -- c1 <- fmap concat $ mapM (toClauses prefix dt) contents -- c2 <- mapM (sToClause prefix dt) sdef -- c3 <- defClause -- return $ -- ( if genType -- then ((DataD [] mname [] (map (toCon dt) sdef) []) :) -- else id) -- [ InstanceD -- [] -- (ConT ''RenderMessage `AppT` (ConT $ mkName master) `AppT` ConT mname) -- [ FunD (mkName "renderMessage") $ c1 ++ c2 ++ [c3] -- ] -- ] -- --toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause] --toClauses prefix dt (lang, defs) = -- mapM go defs -- where -- go def = do -- a <- newName "lang" -- (pat, bod) <- mkBody dt (prefix ++ constr def) (map fst $ vars def) (content def) -- guard <- fmap NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|] -- return $ Clause -- [WildP, ConP (mkName ":") [VarP a, WildP], pat] -- (GuardedB [(guard, bod)]) -- [] -- --mkBody :: String -- ^ datatype -- -> String -- ^ constructor -- -> [String] -- ^ variable names -- -> [Content] -- -> Q (Pat, Exp) --mkBody dt cs vs ct = do -- vp <- mapM go vs -- let pat = RecP (mkName cs) (map (varName dt *** VarP) vp) -- let ct' = map (fixVars vp) ct -- pack' <- [|Data.Text.pack|] -- tomsg <- [|toMessage|] -- let ct'' = map (toH pack' tomsg) ct' -- mapp <- [|mappend|] -- let app a b = InfixE (Just a) mapp (Just b) -- e <- -- case ct'' of -- [] -> [|mempty|] -- [x] -> return x -- (x:xs) -> return $ foldl' app x xs -- return (pat, e) -- where -- toH pack' _ (Raw s) = pack' `AppE` SigE (LitE (StringL s)) (ConT ''String) -- toH _ tomsg (Var d) = tomsg `AppE` derefToExp [] d -- go x = do -- let y = mkName $ '_' : x -- return (x, y) -- fixVars vp (Var d) = Var $ fixDeref vp d -- fixVars _ (Raw s) = Raw s -- fixDeref vp (DerefIdent (Ident i)) = DerefIdent $ Ident $ fixIdent vp i -- fixDeref vp (DerefBranch a b) = DerefBranch (fixDeref vp a) (fixDeref vp b) -- fixDeref _ d = d -- fixIdent vp i = -- case lookup i vp of -- Nothing -> i -- Just y -> nameBase y -- --sToClause :: String -> String -> SDef -> Q Clause --sToClause prefix dt sdef = do -- (pat, bod) <- mkBody dt (prefix ++ sconstr sdef) (map fst $ svars sdef) (scontent sdef) -- return $ Clause -- [WildP, ConP (mkName "[]") [], pat] -- (NormalB bod) -- [] -- --defClause :: Q Clause --defClause = do -- a <- newName "sub" -- c <- newName "langs" -- d <- newName "msg" -- rm <- [|renderMessage|] -- return $ Clause -- [VarP a, ConP (mkName ":") [WildP, VarP c], VarP d] -- (NormalB $ rm `AppE` VarE a `AppE` VarE c `AppE` VarE d) -- [] -- - toCon :: String -> SDef -> Con - toCon dt (SDef c vs _) = - RecC (mkName $ "Msg" ++ c) $ map go vs -@@ -257,39 +120,6 @@ varName a y = - upper (x:xs) = toUpper x : xs - upper [] = [] - --checkDef :: [SDef] -> [Def] -> Q () --checkDef x y = -- go (sortBy (comparing sconstr) x) (sortBy (comparing constr) y) -- where -- go _ [] = return () -- go [] (b:_) = error $ "Extra message constructor: " ++ constr b -- go (a:as) (b:bs) -- | sconstr a < constr b = go as (b:bs) -- | sconstr a > constr b = error $ "Extra message constructor: " ++ constr b -- | otherwise = do -- go' (svars a) (vars b) -- go as bs -- go' ((an, at):as) ((bn, mbt):bs) -- | an /= bn = error "Mismatched variable names" -- | otherwise = -- case mbt of -- Nothing -> go' as bs -- Just bt -- | at == bt -> go' as bs -- | otherwise -> error "Mismatched variable types" -- go' [] [] = return () -- go' _ _ = error "Mistmached variable count" -- --toSDefs :: [Def] -> Q [SDef] --toSDefs = mapM toSDef -- --toSDef :: Def -> Q SDef --toSDef d = do -- vars' <- mapM go $ vars d -- return $ SDef (constr d) vars' (content d) -- where -- go (a, Just b) = return (a, b) -- go (a, Nothing) = error $ "Main language missing type for " ++ show (constr d, a) - - data SDef = SDef - { sconstr :: String --- -1.8.5.1 - |