summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Hakyll/Check.hs15
-rw-r--r--src/Hakyll/Core/Rules/Internal.hs24
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