diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Check.hs | 15 | ||||
| -rw-r--r-- | src/Hakyll/Core/Rules/Internal.hs | 24 |
2 files changed, 20 insertions, 19 deletions
diff --git a/src/Hakyll/Check.hs b/src/Hakyll/Check.hs index 5f8f4f7..a426f87 100644 --- a/src/Hakyll/Check.hs +++ b/src/Hakyll/Check.hs @@ -16,11 +16,12 @@ import Control.Monad.RWS (RWST, runRWST) import Control.Monad.State (get, modify) import Control.Monad.Trans (liftIO) import Control.Monad.Writer (tell) -import Data.List (isPrefixOf) +import Data.List (intercalate, isPrefixOf) import Data.Monoid (Monoid (..)) import Data.Set (Set) import qualified Data.Set as S import Data.Typeable (cast) +import GHC.Exts (fromString) import qualified Network.HTTP.Conduit as Http import qualified Network.HTTP.Types as Http import System.Directory (doesDirectoryExist, doesFileExist) @@ -30,11 +31,13 @@ import qualified Text.HTML.TagSoup as TS -------------------------------------------------------------------------------- +import Data.Version (versionBranch) import Hakyll.Core.Configuration import Hakyll.Core.Logger (Logger, Verbosity) import qualified Hakyll.Core.Logger as Logger import Hakyll.Core.Util.File import Hakyll.Web.Html +import qualified Paths_hakyll as Paths_hakyll -------------------------------------------------------------------------------- @@ -172,11 +175,17 @@ checkExternalUrl url = do modify $ S.insert url if isOk then ok url else faulty url where + -- Add additional request info settings r = r - { Http.method = "HEAD" - , Http.redirectCount = 10 + { Http.method = "HEAD" + , Http.redirectCount = 10 + , Http.requestHeaders = ("User-Agent", ua) : Http.requestHeaders r } + -- Nice user agent info + ua = fromString $ "hakyll-check/" ++ + (intercalate "." $ map show $ versionBranch $ Paths_hakyll.version) + -- Catch all the things except UserInterrupt failure logger (SomeException e) = case cast e of Just UserInterrupt -> throw UserInterrupt diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index 09d9b1e..6bb82df 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -16,9 +16,9 @@ import Control.Applicative (Applicative, (<$>)) import Control.Monad.Reader (ask) import Control.Monad.RWS (RWST, runRWST) import Control.Monad.Trans (liftIO) +import qualified Data.Map as M import Data.Monoid (Monoid, mappend, mempty) import Data.Set (Set) -import qualified Data.Set as S -------------------------------------------------------------------------------- @@ -92,25 +92,17 @@ instance MonadMetadata Rules where runRules :: Rules a -> Provider -> IO RuleSet runRules rules provider = do (_, _, ruleSet) <- runRWST (unRules rules) env emptyRulesState - case findDuplicate (map fst $ rulesCompilers ruleSet) of - Nothing -> return ruleSet - Just id' -> error $ - "Hakyll.Core.Rules.Internal: two different rules for " ++ - show id' ++ " exist, bailing out" + -- Ensure compiler uniqueness + let ruleSet' = ruleSet + { rulesCompilers = M.toList $ + M.fromListWith (flip const) (rulesCompilers ruleSet) + } + + return ruleSet' where env = RulesRead { rulesProvider = provider , rulesMatches = [] , rulesVersion = Nothing } - - --------------------------------------------------------------------------------- -findDuplicate :: Ord a => [a] -> Maybe a -findDuplicate = go S.empty - where - go _ [] = Nothing - go s (x : xs) - | x `S.member` s = Just x - | otherwise = go (S.insert x s) xs |