89272dd · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Simplify stuff

89272ddJasper Van der Jeugt14 years ago

src/Hakyll/Core/Compiler/Internal.hs+10−37

compare with master

unifiedsplit

@@ -4,7 +4,8 @@

4{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5module Hakyll.Core.Compiler.Internal

6 ( CompilerRead (..)

7− , Compiler (..)

7+ , Compiler

8+ , runCompiler

8 , compilerTell

9 , compilerTell

9 , compilerAsk

10 , compilerAsk

10 , compilerThrow

11 , compilerThrow

@@ -31,11 +32,11 @@ import Hakyll.Core.Store

31-- | Environment in which a compiler runs

32-- | Environment in which a compiler runs

32data CompilerRead = CompilerRead

33data CompilerRead = CompilerRead

33 { -- | Target identifier

34 { -- | Target identifier

34− compilerIdentifier :: Identifier ()

35+ compilerIdentifier :: Identifier

35 , -- | Resource provider

36 , -- | Resource provider

36 compilerResourceProvider :: ResourceProvider

37 compilerResourceProvider :: ResourceProvider

37 , -- | List of all known identifiers

38 , -- | List of all known identifiers

38− compilerUniverse :: [Identifier ()]

39+ compilerUniverse :: [Identifier]

39 , -- | Site routes

40 , -- | Site routes

40 compilerRoutes :: Routes

41 compilerRoutes :: Routes

41 , -- | Compiler store

42 , -- | Compiler store

@@ -55,7 +56,7 @@ type CompilerWrite = [Dependency]

55data CompilerResult a where

56data CompilerResult a where

56 CompilerDone :: a -> CompilerWrite -> CompilerResult a

57 CompilerDone :: a -> CompilerWrite -> CompilerResult a

57 CompilerError :: String -> CompilerResult a

58 CompilerError :: String -> CompilerResult a

58− CompilerRequire :: Identifier b -> (b -> Compiler a) -> CompilerResult a

59+ CompilerRequire :: Identifier -> (b -> Compiler a) -> CompilerResult a

61--------------------------------------------------------------------------------

62--------------------------------------------------------------------------------

@@ -106,6 +107,11 @@ instance Applicative Compiler where

106 {-# INLINE (<*>) #-}

107 {-# INLINE (<*>) #-}

107

108

109

110+--------------------------------------------------------------------------------

111+runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)

112+runCompiler = unCompiler

113+

114+

109--------------------------------------------------------------------------------

115--------------------------------------------------------------------------------

110instance Alternative Compiler where

116instance Alternative Compiler where

111 empty = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative"

117 empty = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative"

@@ -139,36 +145,3 @@ compilerCatch (Compiler x) f = Compiler $ \r -> do

139 CompilerError e -> unCompiler (f e) r

145 CompilerError e -> unCompiler (f e) r

140 _ -> return res

146 _ -> return res

141{-# INLINE compilerCatch #-}

147{-# INLINE compilerCatch #-}

142−

143−

144−{-

145−--------------------------------------------------------------------------------

146−-- | The compiler monad

147−newtype CompilerM a = CompilerM

148− { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a

149− } deriving (Monad, Functor, Applicative)

150−

151−

152−--------------------------------------------------------------------------------

153−-- | The compiler arrow

154−data Compiler a = Compiler

155− { compilerDependencies :: Reader DependencyEnvironment Dependencies

156− , compilerJob :: CompilerM a

157− }

158−

159−

160−--------------------------------------------------------------------------------

161−instance Functor Compiler where

162− fmap f (Compiler d j) = Compiler d $ fmap f j

163− {-# INLINE fmap #-}

164−

165−

166−--------------------------------------------------------------------------------

167−instance Applicative Compiler where

168− pure = fromJob . return

169− {-# INLINE pure #-}

170−

171− Compiler d1 j1 <*> Compiler d2 j2 =

172− Compiler (liftM2 S.union d1 d2) $ j1 <*> j2

173− {-# INLINE (<*>) #-}

174−-}

src/Hakyll/Core/Dependencies.hs+11−11

@@ -28,21 +28,21 @@ import Hakyll.Core.Identifier.Pattern

29--------------------------------------------------------------------------------

30data Dependency

31− = Pattern (Pattern ()) [Identifier ()]

31+ = Pattern Pattern [Identifier]

32− | Identifier (Identifier ())

32+ | Identifier Identifier

33 deriving (Show)

36--------------------------------------------------------------------------------

37−type DependencyFacts = Map (Identifier ()) [Dependency]

37+type DependencyFacts = Map Identifier [Dependency]

40--------------------------------------------------------------------------------

41outOfDate

42− :: [Identifier ()] -- ^ All known identifiers

42+ :: [Identifier] -- ^ All known identifiers

43− -> Set (Identifier ()) -- ^ Initially out-of-date resources

43+ -> Set Identifier -- ^ Initially out-of-date resources

44− -> DependencyFacts -- ^ Old dependency facts

44+ -> DependencyFacts -- ^ Old dependency facts

45− -> (Set (Identifier ()), DependencyFacts, [String])

45+ -> (Set Identifier, DependencyFacts, [String])

46outOfDate universe ood oldFacts =

47 let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood)

48 in (dependencyOod state, dependencyFacts state, logs)

@@ -56,21 +56,21 @@ outOfDate universe ood oldFacts =

56--------------------------------------------------------------------------------

57data DependencyState = DependencyState

58 { dependencyFacts :: DependencyFacts

59− , dependencyOod :: Set (Identifier ())

59+ , dependencyOod :: Set Identifier

60 } deriving (Show)

63--------------------------------------------------------------------------------

64−type DependencyM a = RWS [Identifier ()] [String] DependencyState a

64+type DependencyM a = RWS [Identifier] [String] DependencyState a

67--------------------------------------------------------------------------------

68−markOod :: Identifier () -> DependencyM ()

68+markOod :: Identifier -> DependencyM ()

69markOod id' = modify $ \s -> s {dependencyOod = S.insert id' $ dependencyOod s}

72--------------------------------------------------------------------------------

73−dependenciesFor :: Identifier () -> DependencyM [Identifier ()]

73+dependenciesFor :: Identifier -> DependencyM [Identifier]

74dependenciesFor id' = do

75 facts <- dependencyFacts <$> get

76 let relevant = fromMaybe [] $ M.lookup id' facts

src/Hakyll/Core/Identifier.hs+8−16

@@ -35,7 +35,6 @@ module Hakyll.Core.Identifier

35 ( Identifier

36 , fromFilePath

37 , toFilePath

38− , castIdentifier

39 , identifierVersion

38 , identifierVersion

40 , setVersion

39 , setVersion

41 ) where

40 ) where

@@ -56,30 +55,30 @@ import GHC.Exts (IsString, fromString)

57--------------------------------------------------------------------------------

56--------------------------------------------------------------------------------

58-- | An identifier used to uniquely identify a value

57-- | An identifier used to uniquely identify a value

59−data Identifier a = Identifier

58+data Identifier = Identifier

60 { identifierVersion :: Maybe String

59 { identifierVersion :: Maybe String

61 , identifierPath :: String

60 , identifierPath :: String

62 } deriving (Eq, Ord, Typeable)

61 } deriving (Eq, Ord, Typeable)

65--------------------------------------------------------------------------------

64--------------------------------------------------------------------------------

66−instance Binary (Identifier a) where

65+instance Binary Identifier where

67 put (Identifier v p) = put v >> put p

66 put (Identifier v p) = put v >> put p

68 get = Identifier <$> get <*> get

67 get = Identifier <$> get <*> get

71--------------------------------------------------------------------------------

70--------------------------------------------------------------------------------

72−instance IsString (Identifier a) where

71+instance IsString Identifier where

73 fromString = fromFilePath

72 fromString = fromFilePath

76--------------------------------------------------------------------------------

75--------------------------------------------------------------------------------

77−instance NFData (Identifier a) where

76+instance NFData Identifier where

78 rnf (Identifier v p) = rnf v `seq` rnf p `seq` ()

77 rnf (Identifier v p) = rnf v `seq` rnf p `seq` ()

81--------------------------------------------------------------------------------

80--------------------------------------------------------------------------------

82−instance Show (Identifier a) where

81+instance Show Identifier where

83 show i = case identifierVersion i of

82 show i = case identifierVersion i of

84 Nothing -> toFilePath i

83 Nothing -> toFilePath i

85 Just v -> toFilePath i ++ " (" ++ v ++ ")"

84 Just v -> toFilePath i ++ " (" ++ v ++ ")"

@@ -87,7 +86,7 @@ instance Show (Identifier a) where

88--------------------------------------------------------------------------------

87--------------------------------------------------------------------------------

89-- | Parse an identifier from a string

88-- | Parse an identifier from a string

90−fromFilePath :: String -> Identifier a

89+fromFilePath :: String -> Identifier

91fromFilePath = Identifier Nothing .

90fromFilePath = Identifier Nothing .

92 intercalate "/" . filter (not . null) . split'

91 intercalate "/" . filter (not . null) . split'

93 where

92 where

@@ -96,17 +95,10 @@ fromFilePath = Identifier Nothing .

97--------------------------------------------------------------------------------

96--------------------------------------------------------------------------------

98-- | Convert an identifier to a relative 'FilePath'

97-- | Convert an identifier to a relative 'FilePath'

99−toFilePath :: Identifier a -> FilePath

98+toFilePath :: Identifier -> FilePath

100toFilePath = identifierPath

99toFilePath = identifierPath

101

100

102

101

103--------------------------------------------------------------------------------

102--------------------------------------------------------------------------------

104−-- | Discard the phantom type parameter of an identifier

105−castIdentifier :: Identifier a -> Identifier b

106−castIdentifier (Identifier v p) = Identifier v p

107−{-# INLINE castIdentifier #-}

108−

109−

110−--------------------------------------------------------------------------------

111−setVersion :: Maybe String -> Identifier a -> Identifier a

103+setVersion :: Maybe String -> Identifier -> Identifier

112setVersion v i = i {identifierVersion = v}

104setVersion v i = i {identifierVersion = v}

src/Hakyll/Core/Identifier/Pattern.hs+18−31

@@ -48,7 +48,6 @@ module Hakyll.Core.Identifier.Pattern

48 -- * Manipulating patterns

49 , complement

50 , withVersion

51− , castPattern

53 -- * Applying patterns

52 -- * Applying patterns

54 , matches

53 , matches

@@ -104,19 +103,19 @@ instance Binary GlobComponent where

104

103

105--------------------------------------------------------------------------------

104--------------------------------------------------------------------------------

106-- | Type that allows matching on identifiers

105-- | Type that allows matching on identifiers

107−data Pattern a

106+data Pattern

108 = Everything

107 = Everything

109− | Complement (Pattern a)

108+ | Complement Pattern

110− | And (Pattern a) (Pattern a)

109+ | And Pattern Pattern

111 | Glob [GlobComponent]

110 | Glob [GlobComponent]

112− | List [Identifier a] -- TODO Maybe use a set here

111+ | List [Identifier] -- TODO Maybe use a set here

113 | Regex String

112 | Regex String

114 | Version (Maybe String)

113 | Version (Maybe String)

115 deriving (Show)

114 deriving (Show)

116

115

117

116

118--------------------------------------------------------------------------------

117--------------------------------------------------------------------------------

119−instance Binary (Pattern a) where

118+instance Binary Pattern where

120 put Everything = putWord8 0

119 put Everything = putWord8 0

121 put (Complement p) = putWord8 1 >> put p

120 put (Complement p) = putWord8 1 >> put p

122 put (And x y) = putWord8 2 >> put x >> put y

121 put (And x y) = putWord8 2 >> put x >> put y

@@ -136,19 +135,19 @@ instance Binary (Pattern a) where

136

135

137

136

138--------------------------------------------------------------------------------

137--------------------------------------------------------------------------------

139−instance IsString (Pattern a) where

138+instance IsString Pattern where

140 fromString = fromGlob

139 fromString = fromGlob

141

140

142

141

143--------------------------------------------------------------------------------

142--------------------------------------------------------------------------------

144−instance Monoid (Pattern a) where

143+instance Monoid Pattern where

145 mempty = Everything

144 mempty = Everything

146 mappend = And

145 mappend = And

147

146

148

147

149--------------------------------------------------------------------------------

148--------------------------------------------------------------------------------

150-- | Parse a pattern from a string

149-- | Parse a pattern from a string

151−fromGlob :: String -> Pattern a

150+fromGlob :: String -> Pattern

152fromGlob = Glob . parse'

151fromGlob = Glob . parse'

153 where

152 where

154 parse' str =

153 parse' str =

@@ -162,7 +161,7 @@ fromGlob = Glob . parse'

162

161

163--------------------------------------------------------------------------------

162--------------------------------------------------------------------------------

164-- | Create a 'Pattern' from a list of 'Identifier's it should match

163-- | Create a 'Pattern' from a list of 'Identifier's it should match

165−fromList :: [Identifier a] -> Pattern a

164+fromList :: [Identifier] -> Pattern

166fromList = List

165fromList = List

167

166

168

167

@@ -172,12 +171,12 @@ fromList = List

172-- Example:

171-- Example:

173--

172--

174-- > regex "^foo/[^x]*$

173-- > regex "^foo/[^x]*$

175−fromRegex :: String -> Pattern a

174+fromRegex :: String -> Pattern

176fromRegex = Regex

175fromRegex = Regex

177

176

178

177

179--------------------------------------------------------------------------------

178--------------------------------------------------------------------------------

180−fromVersion :: Maybe String -> Pattern a

179+fromVersion :: Maybe String -> Pattern

181fromVersion = Version

180fromVersion = Version

182

181

183

182

@@ -187,7 +186,7 @@ fromVersion = Version

187-- > complement "foo/bar.html"

186-- > complement "foo/bar.html"

188--

187--

189-- will match /anything/ except @\"foo\/bar.html\"@

188-- will match /anything/ except @\"foo\/bar.html\"@

190−complement :: Pattern a -> Pattern a

189+complement :: Pattern -> Pattern

191complement = Complement

190complement = Complement

192

191

193

192

@@ -195,25 +194,13 @@ complement = Complement

195-- | Specify a version, e.g.

194-- | Specify a version, e.g.

196--

195--

197-- > "foo/*.markdown" `withVersion` "pdf"

196-- > "foo/*.markdown" `withVersion` "pdf"

198−withVersion :: Pattern a -> String -> Pattern a

197+withVersion :: Pattern -> String -> Pattern

199withVersion p v = And p $ fromVersion $ Just v

198withVersion p v = And p $ fromVersion $ Just v

200

199

201

200

202−--------------------------------------------------------------------------------

203−-- | Discard the phantom type parameter

204−castPattern :: Pattern a -> Pattern b

205−castPattern Everything = Everything

206−castPattern (Complement x) = Complement (castPattern x)

207−castPattern (And x y) = And (castPattern x) (castPattern y)

208−castPattern (Glob g) = Glob g

209−castPattern (List l) = List $ map castIdentifier l

210−castPattern (Regex r) = Regex r

211−castPattern (Version v) = Version v

212−

213−

214--------------------------------------------------------------------------------

201--------------------------------------------------------------------------------

215-- | Check if an identifier matches a pattern

202-- | Check if an identifier matches a pattern

216−matches :: Pattern a -> Identifier a -> Bool

203+matches :: Pattern -> Identifier -> Bool

217matches Everything _ = True

204matches Everything _ = True

218matches (Complement p) i = not $ matches p i

205matches (Complement p) i = not $ matches p i

219matches (And x y) i = matches x i && matches y i

206matches (And x y) i = matches x i && matches y i

@@ -225,7 +212,7 @@ matches (Version v) i = identifierVersion i == v

225

212

226--------------------------------------------------------------------------------

213--------------------------------------------------------------------------------

227-- | Given a list of identifiers, retain only those who match the given pattern

214-- | Given a list of identifiers, retain only those who match the given pattern

228−filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]

215+filterMatches :: Pattern -> [Identifier] -> [Identifier]

229filterMatches = filter . matches

216filterMatches = filter . matches

230

217

231

218

@@ -238,7 +225,7 @@ splits = inits &&& tails >>> uncurry zip >>> reverse

238

225

239--------------------------------------------------------------------------------

226--------------------------------------------------------------------------------

240-- | Match a glob against a pattern, generating a list of captures

227-- | Match a glob against a pattern, generating a list of captures

241−capture :: Pattern a -> Identifier a -> Maybe [String]

228+capture :: Pattern -> Identifier -> Maybe [String]

242capture (Glob p) i = capture' p (toFilePath i)

229capture (Glob p) i = capture' p (toFilePath i)

243capture _ _ = Nothing

230capture _ _ = Nothing

244

231

@@ -272,14 +259,14 @@ capture' (CaptureMany : ms) str =

272-- Result:

259-- Result:

273--

260--

274-- > "tags/foo"

261-- > "tags/foo"

275−fromCapture :: Pattern a -> String -> Identifier a

262+fromCapture :: Pattern -> String -> Identifier

276fromCapture pattern = fromCaptures pattern . repeat

263fromCapture pattern = fromCaptures pattern . repeat

277

264

278

265

279--------------------------------------------------------------------------------

266--------------------------------------------------------------------------------

280-- | Create an identifier from a pattern by filling in the captures with the

267-- | Create an identifier from a pattern by filling in the captures with the

281-- given list of strings

268-- given list of strings

282−fromCaptures :: Pattern a -> [String] -> Identifier a

269+fromCaptures :: Pattern -> [String] -> Identifier

283fromCaptures (Glob p) = fromFilePath . fromCaptures' p

270fromCaptures (Glob p) = fromFilePath . fromCaptures' p

284fromCaptures _ = error $

271fromCaptures _ = error $

285 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++

272 "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++

src/Hakyll/Core/Metadata.hs+1−1

@@ -19,6 +19,6 @@ type Metadata = Map String String

20--------------------------------------------------------------------------------

21class MonadMetadata m where

22− identifierMetadata :: Identifier a -> m Metadata

22+ identifierMetadata :: Identifier -> m Metadata

23 -- allMetadata :: m [(Resource, Metadata)]

24 -- patternMetadata :: Pattern a -> m [(Resource, Metadata)]

src/Hakyll/Core/ResourceProvider.hs+2−2

@@ -32,7 +32,7 @@ import Hakyll.Core.ResourceProvider.Modified

33--------------------------------------------------------------------------------

34-- | Wrapper to ensure metadata cache is invalidated if necessary

35−resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata

35+resourceMetadata :: ResourceProvider -> Identifier -> IO Metadata

36resourceMetadata rp r = do

37 _ <- resourceModified rp r

38 Internal.resourceMetadata rp r

@@ -40,7 +40,7 @@ resourceMetadata rp r = do

41--------------------------------------------------------------------------------

42-- | Wrapper to ensure metadata cache is invalidated if necessary

43−resourceBody :: ResourceProvider -> Identifier a -> IO String

43+resourceBody :: ResourceProvider -> Identifier -> IO String

44resourceBody rp r = do

45 _ <- resourceModified rp r

46 Internal.resourceBody rp r

src/Hakyll/Core/ResourceProvider/Internal.hs+8−8

@@ -33,9 +33,9 @@ import Hakyll.Core.Identifier

33-- | Responsible for retrieving and listing resources

34data ResourceProvider = ResourceProvider

35 { -- | A list of all files found

36− resourceSet :: Set (Identifier ())

36+ resourceSet :: Set Identifier

37 , -- | Cache keeping track of modified files

38− resourceModifiedCache :: IORef (Map (Identifier ()) Bool)

38+ resourceModifiedCache :: IORef (Map Identifier Bool)

39 , -- | Underlying persistent store for caching

40 resourceStore :: Store

41 }

@@ -55,32 +55,32 @@ newResourceProvider store ignore directory = do

57--------------------------------------------------------------------------------

58−resourceList :: ResourceProvider -> [Identifier ()]

58+resourceList :: ResourceProvider -> [Identifier]

59resourceList = S.toList . resourceSet

62--------------------------------------------------------------------------------

63-- | Check if a given resource exists

64−resourceExists :: ResourceProvider -> Identifier a -> Bool

64+resourceExists :: ResourceProvider -> Identifier -> Bool

65resourceExists provider =

66− (`S.member` resourceSet provider) . setVersion Nothing . castIdentifier

66+ (`S.member` resourceSet provider) . setVersion Nothing

69--------------------------------------------------------------------------------

70-- | Each resource may have an associated metadata resource (with a @.metadata@

71-- filename)

72−resourceMetadataResource :: Identifier a -> Identifier ()

72+resourceMetadataResource :: Identifier -> Identifier

73resourceMetadataResource =

74 fromFilePath . flip addExtension "metadata" . toFilePath

77--------------------------------------------------------------------------------

78-- | Get the raw body of a resource as string

79−resourceString :: Identifier a -> IO String

79+resourceString :: Identifier -> IO String

80resourceString = readFile . toFilePath

83--------------------------------------------------------------------------------

84-- | Get the raw body of a resource of a lazy bytestring

85−resourceLBS :: Identifier a -> IO BL.ByteString

85+resourceLBS :: Identifier -> IO BL.ByteString

86resourceLBS = BL.readFile . toFilePath

src/Hakyll/Core/ResourceProvider/Metadata.hs+1−1

@@ -24,7 +24,7 @@ import Hakyll.Core.Util.String

26--------------------------------------------------------------------------------

27−loadMetadata :: ResourceProvider -> Identifier a -> IO (Metadata, Maybe String)

27+loadMetadata :: ResourceProvider -> Identifier -> IO (Metadata, Maybe String)

28loadMetadata rp identifier = do

29 hasHeader <- probablyHasMetadataHeader fp

30 (md, body) <- if hasHeader

src/Hakyll/Core/ResourceProvider/MetadataCache.hs+4−4

@@ -15,7 +15,7 @@ import qualified Hakyll.Core.Store as Store

17--------------------------------------------------------------------------------

18−resourceMetadata :: ResourceProvider -> Identifier a -> IO Metadata

18+resourceMetadata :: ResourceProvider -> Identifier -> IO Metadata

19resourceMetadata rp r = do

20 load rp r

21 Store.Found md <- Store.get (resourceStore rp)

@@ -24,7 +24,7 @@ resourceMetadata rp r = do

26--------------------------------------------------------------------------------

27−resourceBody :: ResourceProvider -> Identifier a -> IO String

27+resourceBody :: ResourceProvider -> Identifier -> IO String

28resourceBody rp r = do

29 load rp r

30 Store.Found bd <- Store.get (resourceStore rp)

@@ -33,14 +33,14 @@ resourceBody rp r = do

35--------------------------------------------------------------------------------

36−resourceInvalidateMetadataCache :: ResourceProvider -> Identifier a -> IO ()

36+resourceInvalidateMetadataCache :: ResourceProvider -> Identifier -> IO ()

37resourceInvalidateMetadataCache rp r = do

38 Store.delete (resourceStore rp) [name, toFilePath r, "metadata"]

39 Store.delete (resourceStore rp) [name, toFilePath r, "body"]

42--------------------------------------------------------------------------------

43−load :: ResourceProvider -> Identifier a -> IO ()

43+load :: ResourceProvider -> Identifier -> IO ()

44load rp r = do

45 mmd <- Store.get store mdk :: IO (Store.Result Metadata)

46 case mmd of

src/Hakyll/Core/ResourceProvider/Modified.hs+3−3

@@ -27,7 +27,7 @@ import qualified Hakyll.Core.Store as Store

28--------------------------------------------------------------------------------

29-- | A resource is modified if it or its metadata has changed

30−resourceModified :: ResourceProvider -> Identifier a -> IO Bool

30+resourceModified :: ResourceProvider -> Identifier -> IO Bool

31resourceModified rp r

32 | not exists = return False

33 | otherwise = do

@@ -47,7 +47,7 @@ resourceModified rp r

48 return m

49 where

50− normalized = castIdentifier $ setVersion Nothing r

50+ normalized = setVersion Nothing r

51 exists = resourceExists rp r

52 store = resourceStore rp

53 cacheRef = resourceModifiedCache rp

@@ -79,5 +79,5 @@ fileDigest = fmap MD5.hashlazy . BL.readFile

81--------------------------------------------------------------------------------

82−resourceModificationTime :: Identifier a -> IO UTCTime

82+resourceModificationTime :: Identifier -> IO UTCTime

83resourceModificationTime = getModificationTime . toFilePath

src/Hakyll/Core/Routes.hs+6−6

@@ -53,7 +53,7 @@ import Hakyll.Core.Util.String

54--------------------------------------------------------------------------------

55-- | Type used for a route

56−newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath}

56+newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath}

59--------------------------------------------------------------------------------

@@ -64,7 +64,7 @@ instance Monoid Routes where

65--------------------------------------------------------------------------------

66-- | Apply a route to an identifier

67−runRoutes :: Routes -> Identifier a -> Maybe FilePath

67+runRoutes :: Routes -> Identifier -> Maybe FilePath

68runRoutes = unRoutes

@@ -101,16 +101,16 @@ setExtension extension = Routes $

101--------------------------------------------------------------------------------

102-- | Apply the route if the identifier matches the given pattern, fail

103-- otherwise

104−matchRoute :: Pattern a -> Routes -> Routes

104+matchRoute :: Pattern -> Routes -> Routes

105matchRoute pattern (Routes route) = Routes $ \id' ->

106− if matches pattern (castIdentifier id') then route id' else Nothing

106+ if matches pattern id' then route id' else Nothing

107

108

109--------------------------------------------------------------------------------

110-- | Create a custom route. This should almost always be used with

111-- 'matchRoute'

112−customRoute :: (Identifier a -> FilePath) -> Routes

112+customRoute :: (Identifier -> FilePath) -> Routes

113−customRoute f = Routes $ Just . f . castIdentifier

113+customRoute f = Routes $ Just . f

114

115

116--------------------------------------------------------------------------------

src/Hakyll/Core/Rules.hs+31−34

@@ -2,7 +2,7 @@

2-- | This module provides a declarative DSL in which the user can specify the

3-- different rules used to run the compilers.

4--

5−-- The convention is to just list all items in the 'RulesM' monad, routes and

5+-- The convention is to just list all items in the 'Rules' monad, routes and

6-- compilation rules.

7--

8-- A typical usage example would be:

@@ -17,8 +17,7 @@

17{-# LANGUAGE GeneralizedNewtypeDeriving #-}

18{-# LANGUAGE OverloadedStrings #-}

19module Hakyll.Core.Rules

20− ( RulesM

21− , Rules

20+ ( Rules

22 , match

21 , match

23 , group

22 , group

24 , compile

23 , compile

@@ -31,7 +30,7 @@ module Hakyll.Core.Rules

32--------------------------------------------------------------------------------

31--------------------------------------------------------------------------------

33import Control.Applicative ((<$>))

32import Control.Applicative ((<$>))

34−import Control.Arrow ((***))

33+import Control.Arrow (second)

35import Control.Monad.Reader (ask, local)

34import Control.Monad.Reader (ask, local)

36import Control.Monad.State (get, put)

35import Control.Monad.State (get, put)

37import Control.Monad.Writer (tell)

36import Control.Monad.Writer (tell)

@@ -57,36 +56,36 @@ import Hakyll.Core.Writable

58--------------------------------------------------------------------------------

57--------------------------------------------------------------------------------

59-- | Add a route

58-- | Add a route

60−tellRoute :: Routes -> Rules

59+tellRoute :: Routes -> Rules ()

61−tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty

60+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty

64--------------------------------------------------------------------------------

63--------------------------------------------------------------------------------

65-- | Add a number of compilers

64-- | Add a number of compilers

66tellCompilers :: (Binary a, Typeable a, Writable a)

65tellCompilers :: (Binary a, Typeable a, Writable a)

67− => [(Identifier a, Compiler a)]

66+ => [(Identifier, Compiler a)]

68− -> Rules

67+ -> Rules ()

69−tellCompilers compilers = RulesM $ do

68+tellCompilers compilers = Rules $ do

70 -- We box the compilers so they have a more simple type

69 -- We box the compilers so they have a more simple type

71− let compilers' = map (castIdentifier *** fmap compiledItem) compilers

70+ let compilers' = map (second $ fmap compiledItem) compilers

72 tell $ RuleSet mempty compilers' mempty

71 tell $ RuleSet mempty compilers' mempty

75--------------------------------------------------------------------------------

74--------------------------------------------------------------------------------

76-- | Add resources

75-- | Add resources

77−tellResources :: [Identifier a]

76+tellResources :: [Identifier]

78− -> Rules

77+ -> Rules ()

79−tellResources resources' = RulesM $ tell $

78+tellResources resources' = Rules $ tell $

80− RuleSet mempty mempty $ S.fromList $ map castIdentifier resources'

79+ RuleSet mempty mempty $ S.fromList resources'

83--------------------------------------------------------------------------------

82--------------------------------------------------------------------------------

84-- | Only compile/route items satisfying the given predicate

83-- | Only compile/route items satisfying the given predicate

85−match :: Pattern a -> RulesM b -> RulesM b

84+match :: Pattern -> Rules b -> Rules b

86−match pattern = RulesM . local addPredicate . unRulesM

85+match pattern = Rules . local addPredicate . unRules

87 where

86 where

88 addPredicate env = env

87 addPredicate env = env

89− { rulesPattern = rulesPattern env `mappend` castPattern pattern

88+ { rulesPattern = rulesPattern env `mappend` pattern

90 }

89 }

@@ -120,8 +119,8 @@ match pattern = RulesM . local addPredicate . unRulesM

120--

119--

121-- This will put the compiler for the raw content in a separate group

120-- This will put the compiler for the raw content in a separate group

122-- (@\"raw\"@), which causes it to be compiled as well.

121-- (@\"raw\"@), which causes it to be compiled as well.

123−group :: String -> RulesM a -> RulesM a

122+group :: String -> Rules a -> Rules a

124−group g = RulesM . local setVersion' . unRulesM

123+group g = Rules . local setVersion' . unRules

125 where

124 where

126 setVersion' env = env {rulesVersion = Just g}

125 setVersion' env = env {rulesVersion = Just g}

127

126

@@ -133,12 +132,11 @@ group g = RulesM . local setVersion' . unRulesM

133-- no resources match the current selection, nothing will happen. In this case,

132-- no resources match the current selection, nothing will happen. In this case,

134-- you might want to have a look at 'create'.

133-- you might want to have a look at 'create'.

135compile :: (Binary a, Typeable a, Writable a)

134compile :: (Binary a, Typeable a, Writable a)

136− => Compiler a -> RulesM (Pattern a)

135+ => Compiler a -> Rules ()

137compile compiler = do

136compile compiler = do

138 ids <- resources

137 ids <- resources

139− tellCompilers [(castIdentifier id', compiler) | id' <- ids]

138+ tellCompilers [(id', compiler) | id' <- ids]

140 tellResources ids

139 tellResources ids

141− return $ fromList $ map castIdentifier ids

142

140

143

141

144--------------------------------------------------------------------------------

142--------------------------------------------------------------------------------

@@ -151,33 +149,32 @@ compile compiler = do

151-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been

149-- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been

152-- used).

150-- used).

153create :: (Binary a, Typeable a, Writable a)

151create :: (Binary a, Typeable a, Writable a)

154− => Identifier a -> Compiler a -> RulesM (Identifier a)

152+ => Identifier -> Compiler a -> Rules ()

155−create id' compiler = RulesM $ do

153+create id' compiler = Rules $ do

156 version' <- rulesVersion <$> ask

154 version' <- rulesVersion <$> ask

157 let id'' = setVersion version' id'

155 let id'' = setVersion version' id'

158− unRulesM $ tellCompilers [(id'', compiler)]

156+ unRules $ tellCompilers [(id'', compiler)]

159− return id''

160

157

161

158

162--------------------------------------------------------------------------------

159--------------------------------------------------------------------------------

163-- | Add a route.

160-- | Add a route.

164--

161--

165-- This adds a route for all items matching the current pattern.

162-- This adds a route for all items matching the current pattern.

166−route :: Routes -> Rules

163+route :: Routes -> Rules ()

167−route route' = RulesM $ do

164+route route' = Rules $ do

168 -- We want the route only to be applied if we match the current pattern and

165 -- We want the route only to be applied if we match the current pattern and

169 -- version

166 -- version

170 pattern <- rulesPattern <$> ask

167 pattern <- rulesPattern <$> ask

171 version' <- rulesVersion <$> ask

168 version' <- rulesVersion <$> ask

172− unRulesM $ tellRoute $ matchRoute

169+ unRules $ tellRoute $ matchRoute

173 (pattern `mappend` fromVersion version') route'

170 (pattern `mappend` fromVersion version') route'

174

171

175

172

176--------------------------------------------------------------------------------

173--------------------------------------------------------------------------------

177-- | Get a list of resources matching the current pattern. This will also set

174-- | Get a list of resources matching the current pattern. This will also set

178-- the correct group to the identifiers.

175-- the correct group to the identifiers.

179−resources :: RulesM [Identifier ()]

176+resources :: Rules [Identifier]

180−resources = RulesM $ do

177+resources = Rules $ do

181 pattern <- rulesPattern <$> ask

178 pattern <- rulesPattern <$> ask

182 provider <- rulesResourceProvider <$> ask

179 provider <- rulesResourceProvider <$> ask

183 g <- rulesVersion <$> ask

180 g <- rulesVersion <$> ask

@@ -187,9 +184,9 @@ resources = RulesM $ do

187--------------------------------------------------------------------------------

184--------------------------------------------------------------------------------

188-- | Generate a fresh Identifier with a given prefix

185-- | Generate a fresh Identifier with a given prefix

189-- TODO: remove?

186-- TODO: remove?

190−freshIdentifier :: String -- ^ Prefix

187+freshIdentifier :: String -- ^ Prefix

191− -> RulesM (Identifier a) -- ^ Fresh identifier

188+ -> Rules Identifier -- ^ Fresh identifier

192−freshIdentifier prefix = RulesM $ do

189+freshIdentifier prefix = Rules $ do

193 state <- get

190 state <- get

194 let index = rulesNextIdentifier state

191 let index = rulesNextIdentifier state

195 id' = fromFilePath $ prefix ++ "/" ++ show index

192 id' = fromFilePath $ prefix ++ "/" ++ show index

src/Hakyll/Core/Rules/Internal.hs+8−15

@@ -6,8 +6,7 @@ module Hakyll.Core.Rules.Internal

6 ( RuleSet (..)

7 , RuleState (..)

8 , RuleEnvironment (..)

9− , RulesM (..)

9+ , Rules (..)

10− , Rules

11 , runRules

10 , runRules

12 ) where

11 ) where

@@ -35,9 +34,9 @@ data RuleSet = RuleSet

35 { -- | Routes used in the compilation structure

34 { -- | Routes used in the compilation structure

36 rulesRoutes :: Routes

35 rulesRoutes :: Routes

37 , -- | Compilation rules

36 , -- | Compilation rules

38− rulesCompilers :: [(Identifier (), Compiler CompiledItem)]

37+ rulesCompilers :: [(Identifier, Compiler CompiledItem)]

39 , -- | A set of the actually used files

38 , -- | A set of the actually used files

40− rulesResources :: Set (Identifier ())

39+ rulesResources :: Set Identifier

41 }

40 }

@@ -59,29 +58,23 @@ data RuleState = RuleState

59-- | Rule environment

58-- | Rule environment

60data RuleEnvironment = RuleEnvironment

59data RuleEnvironment = RuleEnvironment

61 { rulesResourceProvider :: ResourceProvider

60 { rulesResourceProvider :: ResourceProvider

62− , rulesPattern :: forall a. Pattern a

61+ , rulesPattern :: Pattern

63 , rulesVersion :: Maybe String

62 , rulesVersion :: Maybe String

64 }

63 }

67--------------------------------------------------------------------------------

66--------------------------------------------------------------------------------

68-- | The monad used to compose rules

67-- | The monad used to compose rules

69−newtype RulesM a = RulesM

68+newtype Rules a = Rules

70− { unRulesM :: RWST RuleEnvironment RuleSet RuleState IO a

69+ { unRules :: RWST RuleEnvironment RuleSet RuleState IO a

71 } deriving (Monad, Functor, Applicative)

70 } deriving (Monad, Functor, Applicative)

74−--------------------------------------------------------------------------------

75−-- | Simplification of the RulesM type; usually, it will not return any

76−-- result.

77−type Rules = RulesM ()

78−

79−

80--------------------------------------------------------------------------------

73--------------------------------------------------------------------------------

81-- | Run a Rules monad, resulting in a 'RuleSet'

74-- | Run a Rules monad, resulting in a 'RuleSet'

82−runRules :: RulesM a -> ResourceProvider -> IO RuleSet

75+runRules :: Rules a -> ResourceProvider -> IO RuleSet

83runRules rules provider = do

76runRules rules provider = do

84− (_, _, ruleSet) <- runRWST (unRulesM rules) env state

77+ (_, _, ruleSet) <- runRWST (unRules rules) env state

85 return $ nubCompilers ruleSet

78 return $ nubCompilers ruleSet

86 where

79 where

87 state = RuleState {rulesNextIdentifier = 0}

80 state = RuleState {rulesNextIdentifier = 0}

src/Hakyll/Core/Writable.hs+1−1

@@ -38,5 +38,5 @@ instance Writable [Word8] where

38instance Writable Html where

39 write p html = write p $ renderHtml html

41−instance Writable (Identifier a) where

41+instance Writable Identifier where

42 write p = write p . show