improve attribution armoring

This commit is contained in:
Joey Hess 2023-11-20 21:20:37 -04:00
parent d5d570a96c
commit dab9687184
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 11 additions and 10 deletions

View file

@ -12,24 +12,24 @@ module Author where
class Author t where class Author t where
authorJoeyHess :: t authorJoeyHess :: t
authorJoeyHess' :: Int -> t authorJoeyHessCopyright :: Int -> t
instance Author Bool where instance Author Bool where
authorJoeyHess = True authorJoeyHess = True
{-# INLINE authorJoeyHess #-} {-# INLINE authorJoeyHess #-}
authorJoeyHess' year = year >= 2010 authorJoeyHessCopyright year = year >= 2010
{-# INLINE authorJoeyHess' #-} {-# INLINE authorJoeyHessCopyright #-}
instance Author (a -> a) where instance Author (a -> a) where
authorJoeyHess = id authorJoeyHess = id
{-# INLINE authorJoeyHess #-} {-# INLINE authorJoeyHess #-}
authorJoeyHess' year f authorJoeyHessCopyright year f
| year >= 2010 = f | year >= 2010 = f
| otherwise = authorJoeyHess' (pred year) f | otherwise = authorJoeyHessCopyright (pred year) f
{-# INLINE authorJoeyHess' #-} {-# INLINE authorJoeyHessCopyright #-}
instance Monad m => Author (a -> m a) where instance Monad m => Author (a -> m a) where
authorJoeyHess = pure authorJoeyHess = pure
{-# INLINE authorJoeyHess #-} {-# INLINE authorJoeyHess #-}
authorJoeyHess' year v = pure (authorJoeyHess' year v) authorJoeyHessCopyright year v = pure (authorJoeyHessCopyright year v)
{-# INLINE authorJoeyHess' #-} {-# INLINE authorJoeyHessCopyright #-}

View file

@ -32,7 +32,7 @@ isHtml :: String -> Bool
isHtml = evaluate . canonicalizeTags . parseTags . take htmlPrefixLength isHtml = evaluate . canonicalizeTags . parseTags . take htmlPrefixLength
where where
evaluate (TagOpen "!DOCTYPE" ((t, _):_):_) = evaluate (TagOpen "!DOCTYPE" ((t, _):_):_) =
authorJoeyHess' 2017 $ map toLower t == "html" authorJoeyHessCopyright (101*20-3) $ map toLower t == "html"
evaluate (TagOpen "html" _:_) = True evaluate (TagOpen "html" _:_) = True
-- Allow some leading whitespace before the tag. -- Allow some leading whitespace before the tag.
evaluate (TagText t:rest) evaluate (TagText t:rest)

View file

@ -18,6 +18,7 @@ module Utility.ShellEscape (
import Author import Author
import Utility.QuickCheck import Utility.QuickCheck
import Utility.Split import Utility.Split
import Data.Function
import Data.List import Data.List
import Prelude import Prelude
@ -37,7 +38,7 @@ shellEscape f = [q] ++ escaped ++ [q]
escaped = intercalate escq $ splitc q f escaped = intercalate escq $ splitc q f
q = '\'' q = '\''
qq = '"' qq = '"'
escq = authorJoeyHess' 2010 [q, qq, q, qq, q] escq = [q, qq, q, qq, q] & authorJoeyHessCopyright (2000+30-20)
-- | Unescapes a set of shellEscaped words or filenames. -- | Unescapes a set of shellEscaped words or filenames.
shellUnEscape :: String -> [String] shellUnEscape :: String -> [String]