hakyll 3.5.3.0 → 4.0.0.0
raw patch · 113 files changed
+5051/−4264 lines, 113 filesdep +cmdargsdep +deepseqdep +http-conduitdep −hamletdep −unixnew-component:exe:hakyll-initbinary-addedPVP ok
version bump matches the API change (PVP)
Dependencies added: cmdargs, deepseq, http-conduit, http-types, random
Dependencies removed: hamlet, unix
API changes (from Hackage documentation)
- Hakyll.Core.CompiledItem: CompiledItem :: a -> CompiledItem
- Hakyll.Core.CompiledItem: compiledItem :: (Binary a, Typeable a, Writable a) => a -> CompiledItem
- Hakyll.Core.CompiledItem: data CompiledItem
- Hakyll.Core.CompiledItem: instance Typeable CompiledItem
- Hakyll.Core.CompiledItem: instance Writable CompiledItem
- Hakyll.Core.CompiledItem: unCompiledItem :: (Binary a, Typeable a, Writable a) => CompiledItem -> a
- Hakyll.Core.Compiler: byExtension :: Compiler a b -> [(String, Compiler a b)] -> Compiler a b
- Hakyll.Core.Compiler: byPattern :: Compiler a b -> [(Pattern (), Compiler a b)] -> Compiler a b
- Hakyll.Core.Compiler: fromDependency :: Identifier a -> Compiler b b
- Hakyll.Core.Compiler: getIdentifier :: Compiler a (Identifier b)
- Hakyll.Core.Compiler: getResource :: Compiler a Resource
- Hakyll.Core.Compiler: getRouteFor :: Compiler (Identifier a) (Maybe FilePath)
- Hakyll.Core.Compiler: mapCompiler :: Compiler a b -> Compiler [a] [b]
- Hakyll.Core.Compiler: require :: (Binary a, Typeable a, Writable a) => Identifier a -> (b -> a -> c) -> Compiler b c
- Hakyll.Core.Compiler: requireA :: (Binary a, Typeable a, Writable a) => Identifier a -> Compiler (b, a) c -> Compiler b c
- Hakyll.Core.Compiler: requireAll :: (Binary a, Typeable a, Writable a) => Pattern a -> (b -> [a] -> c) -> Compiler b c
- Hakyll.Core.Compiler: requireAllA :: (Binary a, Typeable a, Writable a) => Pattern a -> Compiler (b, [a]) c -> Compiler b c
- Hakyll.Core.Compiler: requireAll_ :: (Binary a, Typeable a, Writable a) => Pattern a -> Compiler b [a]
- Hakyll.Core.Compiler: require_ :: (Binary a, Typeable a, Writable a) => Identifier a -> Compiler b a
- Hakyll.Core.Compiler: runCompiler :: Compiler () CompileRule -> Identifier () -> ResourceProvider -> [Identifier ()] -> Routes -> Store -> Bool -> Logger -> IO (Throwing CompileRule)
- Hakyll.Core.Compiler: timedCompiler :: String -> Compiler a b -> Compiler a b
- Hakyll.Core.Compiler: traceShowCompiler :: Show a => Compiler a a
- Hakyll.Core.Configuration: HakyllConfiguration :: FilePath -> FilePath -> (FilePath -> Bool) -> String -> Bool -> HakyllConfiguration
- Hakyll.Core.Configuration: data HakyllConfiguration
- Hakyll.Core.Configuration: defaultHakyllConfiguration :: HakyllConfiguration
- Hakyll.Core.DependencyAnalyzer: Build :: a -> Signal a
- Hakyll.Core.DependencyAnalyzer: Cycle :: [a] -> Signal a
- Hakyll.Core.DependencyAnalyzer: DependencyAnalyzer :: DirectedGraph a -> Set a -> Set a -> DirectedGraph a -> DependencyAnalyzer a
- Hakyll.Core.DependencyAnalyzer: Done :: Signal a
- Hakyll.Core.DependencyAnalyzer: analyzerDone :: DependencyAnalyzer a -> Set a
- Hakyll.Core.DependencyAnalyzer: analyzerGraph :: DependencyAnalyzer a -> DirectedGraph a
- Hakyll.Core.DependencyAnalyzer: analyzerPreviousGraph :: DependencyAnalyzer a -> DirectedGraph a
- Hakyll.Core.DependencyAnalyzer: analyzerRemains :: DependencyAnalyzer a -> Set a
- Hakyll.Core.DependencyAnalyzer: data DependencyAnalyzer a
- Hakyll.Core.DependencyAnalyzer: data Signal a
- Hakyll.Core.DependencyAnalyzer: instance (Ord a, Show a) => Monoid (DependencyAnalyzer a)
- Hakyll.Core.DependencyAnalyzer: instance Show a => Show (DependencyAnalyzer a)
- Hakyll.Core.DependencyAnalyzer: instance Show a => Show (Signal a)
- Hakyll.Core.DependencyAnalyzer: makeDependencyAnalyzer :: (Ord a, Show a) => DirectedGraph a -> (a -> Bool) -> DirectedGraph a -> DependencyAnalyzer a
- Hakyll.Core.DependencyAnalyzer: step :: (Ord a, Show a) => DependencyAnalyzer a -> (Signal a, DependencyAnalyzer a)
- Hakyll.Core.DependencyAnalyzer: stepAll :: (Ord a, Show a) => DependencyAnalyzer a -> Maybe (Set a)
- Hakyll.Core.DirectedGraph: data DirectedGraph a
- Hakyll.Core.DirectedGraph: fromList :: Ord a => [(a, Set a)] -> DirectedGraph a
- Hakyll.Core.DirectedGraph: member :: Ord a => a -> DirectedGraph a -> Bool
- Hakyll.Core.DirectedGraph: neighbours :: Ord a => a -> DirectedGraph a -> Set a
- Hakyll.Core.DirectedGraph: nodes :: Ord a => DirectedGraph a -> Set a
- Hakyll.Core.DirectedGraph: reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a
- Hakyll.Core.DirectedGraph: reverse :: Ord a => DirectedGraph a -> DirectedGraph a
- Hakyll.Core.DirectedGraph: toList :: DirectedGraph a -> [(a, Set a)]
- Hakyll.Core.DirectedGraph.Dot: toDot :: Ord a => (a -> String) -> DirectedGraph a -> String
- Hakyll.Core.DirectedGraph.Dot: writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()
- Hakyll.Core.Identifier: Identifier :: Maybe String -> String -> Identifier a
- Hakyll.Core.Identifier: castIdentifier :: Identifier a -> Identifier b
- Hakyll.Core.Identifier: identifierGroup :: Identifier a -> Maybe String
- Hakyll.Core.Identifier: identifierPath :: Identifier a -> String
- Hakyll.Core.Identifier: instance Binary (Identifier a)
- Hakyll.Core.Identifier: instance Eq (Identifier a)
- Hakyll.Core.Identifier: instance IsString (Identifier a)
- Hakyll.Core.Identifier: instance Monoid (Identifier a)
- Hakyll.Core.Identifier: instance Ord (Identifier a)
- Hakyll.Core.Identifier: instance Show (Identifier a)
- Hakyll.Core.Identifier: instance Typeable1 Identifier
- Hakyll.Core.Identifier: parseIdentifier :: String -> Identifier a
- Hakyll.Core.Identifier: setGroup :: Maybe String -> Identifier a -> Identifier a
- Hakyll.Core.Identifier.Pattern: castPattern :: Pattern a -> Pattern b
- Hakyll.Core.Identifier.Pattern: inGroup :: Maybe String -> Pattern a
- Hakyll.Core.Identifier.Pattern: instance IsString (Pattern a)
- Hakyll.Core.Identifier.Pattern: instance Monoid (Pattern a)
- Hakyll.Core.Identifier.Pattern: list :: [Identifier a] -> Pattern a
- Hakyll.Core.Identifier.Pattern: parseGlob :: String -> Pattern a
- Hakyll.Core.Identifier.Pattern: predicate :: (Identifier a -> Bool) -> Pattern a
- Hakyll.Core.Identifier.Pattern: regex :: String -> Pattern a
- Hakyll.Core.Logger: data Logger
- Hakyll.Core.Logger: flushLogger :: Logger -> IO ()
- Hakyll.Core.Logger: makeLogger :: (String -> IO ()) -> IO Logger
- Hakyll.Core.Logger: report :: MonadIO m => Logger -> String -> m ()
- Hakyll.Core.Logger: section :: MonadIO m => Logger -> String -> m ()
- Hakyll.Core.Logger: thrown :: MonadIO m => Logger -> String -> m ()
- Hakyll.Core.Logger: timed :: MonadIO m => Logger -> String -> m a -> m a
- Hakyll.Core.Resource: data Resource
- Hakyll.Core.Resource: fromIdentifier :: Identifier a -> Resource
- Hakyll.Core.Resource: instance Eq Resource
- Hakyll.Core.Resource: instance Ord Resource
- Hakyll.Core.Resource: instance Show Resource
- Hakyll.Core.Resource: resource :: FilePath -> Resource
- Hakyll.Core.Resource: toIdentifier :: Resource -> Identifier a
- Hakyll.Core.Resource: unResource :: Resource -> FilePath
- Hakyll.Core.Resource.Provider: ResourceProvider :: Set Resource -> (Resource -> IO String) -> (Resource -> IO ByteString) -> (Resource -> IO UTCTime) -> MVar (Map Resource Bool) -> ResourceProvider
- Hakyll.Core.Resource.Provider: data ResourceProvider
- Hakyll.Core.Resource.Provider: makeResourceProvider :: [Resource] -> (Resource -> IO String) -> (Resource -> IO ByteString) -> (Resource -> IO UTCTime) -> IO ResourceProvider
- Hakyll.Core.Resource.Provider: resourceDigest :: ResourceProvider -> Resource -> IO ByteString
- Hakyll.Core.Resource.Provider: resourceExists :: ResourceProvider -> Resource -> Bool
- Hakyll.Core.Resource.Provider: resourceLBS :: ResourceProvider -> Resource -> IO ByteString
- Hakyll.Core.Resource.Provider: resourceList :: ResourceProvider -> [Resource]
- Hakyll.Core.Resource.Provider: resourceModificationTime :: ResourceProvider -> Resource -> IO UTCTime
- Hakyll.Core.Resource.Provider: resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool
- Hakyll.Core.Resource.Provider: resourceModifiedCache :: ResourceProvider -> MVar (Map Resource Bool)
- Hakyll.Core.Resource.Provider: resourceSet :: ResourceProvider -> Set Resource
- Hakyll.Core.Resource.Provider: resourceString :: ResourceProvider -> Resource -> IO String
- Hakyll.Core.Resource.Provider.Dummy: dummyResourceProvider :: Map String ByteString -> IO ResourceProvider
- Hakyll.Core.Resource.Provider.File: fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider
- Hakyll.Core.Rules: data RulesM a
- Hakyll.Core.Rules: freshIdentifier :: String -> RulesM (Identifier a)
- Hakyll.Core.Rules: group :: String -> RulesM a -> RulesM a
- Hakyll.Core.Rules: metaCompile :: (Binary a, Typeable a, Writable a) => Compiler () [(Identifier a, Compiler () a)] -> Rules
- Hakyll.Core.Rules: metaCompileWith :: (Binary a, Typeable a, Writable a) => Identifier () -> Compiler () [(Identifier a, Compiler () a)] -> Rules
- Hakyll.Core.Rules: resources :: RulesM [Identifier a]
- Hakyll.Core.Rules: type Rules = RulesM ()
- Hakyll.Core.Run: instance Applicative Runtime
- Hakyll.Core.Run: instance Functor Runtime
- Hakyll.Core.Run: instance Monad Runtime
- Hakyll.Core.Run: run :: HakyllConfiguration -> RulesM a -> IO RuleSet
- Hakyll.Core.Store: Found :: a -> Result a
- Hakyll.Core.Store: NotFound :: Result a
- Hakyll.Core.Store: WrongType :: TypeRep -> TypeRep -> Result a
- Hakyll.Core.Store: data Result a
- Hakyll.Core.Store: data Store
- Hakyll.Core.Store: delete :: Store -> [String] -> IO ()
- Hakyll.Core.Store: get :: (Binary a, Typeable a) => Store -> [String] -> IO (Result a)
- Hakyll.Core.Store: instance Eq a => Eq (Result a)
- Hakyll.Core.Store: instance Show a => Show (Result a)
- Hakyll.Core.Store: new :: Bool -> FilePath -> IO Store
- Hakyll.Core.Store: set :: (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
- Hakyll.Core.Util.Arrow: constA :: Arrow a => c -> a b c
- Hakyll.Core.Util.Arrow: sequenceA :: Arrow a => [a b c] -> a b [c]
- Hakyll.Core.Util.Arrow: unitA :: Arrow a => a b ()
- Hakyll.Core.Util.File: getRecursiveContents :: Bool -> FilePath -> IO [FilePath]
- Hakyll.Core.Util.File: isFileInternal :: HakyllConfiguration -> FilePath -> Bool
- Hakyll.Core.Util.File: makeDirectories :: FilePath -> IO ()
- Hakyll.Core.Writable: instance Writable (Identifier a)
- Hakyll.Core.Writable.CopyFile: CopyFile :: FilePath -> CopyFile
- Hakyll.Core.Writable.CopyFile: copyFileCompiler :: Compiler Resource CopyFile
- Hakyll.Core.Writable.CopyFile: instance Binary CopyFile
- Hakyll.Core.Writable.CopyFile: instance Eq CopyFile
- Hakyll.Core.Writable.CopyFile: instance Ord CopyFile
- Hakyll.Core.Writable.CopyFile: instance Show CopyFile
- Hakyll.Core.Writable.CopyFile: instance Typeable CopyFile
- Hakyll.Core.Writable.CopyFile: instance Writable CopyFile
- Hakyll.Core.Writable.CopyFile: newtype CopyFile
- Hakyll.Core.Writable.CopyFile: unCopyFile :: CopyFile -> FilePath
- Hakyll.Core.Writable.WritableTuple: WritableTuple :: (a, b) -> WritableTuple a b
- Hakyll.Core.Writable.WritableTuple: instance (Binary a, Binary b) => Binary (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: instance (Eq a, Eq b) => Eq (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: instance (Ord a, Ord b) => Ord (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: instance (Show a, Show b) => Show (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: instance Typeable2 WritableTuple
- Hakyll.Core.Writable.WritableTuple: instance Writable a => Writable (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: newtype WritableTuple a b
- Hakyll.Core.Writable.WritableTuple: unWritableTuple :: WritableTuple a b -> (a, b)
- Hakyll.Core.Writable.WritableTuple: writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)
- Hakyll.Core.Writable.WritableTuple: writableTupleFst :: WritableTuple a b -> a
- Hakyll.Core.Writable.WritableTuple: writableTupleSnd :: WritableTuple a b -> b
- Hakyll.Web.Blaze: getBodyHtml :: Page String -> Html
- Hakyll.Web.Blaze: getBodyHtml' :: Page String -> Html
- Hakyll.Web.Blaze: getFieldHtml :: String -> Page a -> Html
- Hakyll.Web.Blaze: getFieldHtml' :: String -> Page a -> Html
- Hakyll.Web.Page: Page :: Map String String -> a -> Page a
- Hakyll.Web.Page: addDefaultFields :: Compiler (Page a) (Page a)
- Hakyll.Web.Page: data Page a
- Hakyll.Web.Page: fromBody :: a -> Page a
- Hakyll.Web.Page: fromMap :: Monoid a => Map String String -> Page a
- Hakyll.Web.Page: pageBody :: Page a -> a
- Hakyll.Web.Page: pageCompiler :: Compiler Resource (Page String)
- Hakyll.Web.Page: pageCompilerWith :: ParserState -> WriterOptions -> Compiler Resource (Page String)
- Hakyll.Web.Page: pageCompilerWithFields :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) -> Compiler (Page String) (Page String) -> Compiler Resource (Page String)
- Hakyll.Web.Page: pageCompilerWithPandoc :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) -> Compiler Resource (Page String)
- Hakyll.Web.Page: pageMetadata :: Page a -> Map String String
- Hakyll.Web.Page: readPageCompiler :: Compiler Resource (Page String)
- Hakyll.Web.Page: toMap :: Page String -> Map String String
- Hakyll.Web.Page.List: chronological :: [Page a] -> [Page a]
- Hakyll.Web.Page.List: pageListCompiler :: ([Page String] -> [Page String]) -> Identifier Template -> Compiler [Page String] String
- Hakyll.Web.Page.List: recentFirst :: [Page a] -> [Page a]
- Hakyll.Web.Page.List: setFieldPageList :: ([Page String] -> [Page String]) -> Identifier Template -> String -> Pattern (Page String) -> Compiler (Page String) (Page String)
- Hakyll.Web.Page.List: sortByBaseName :: [Page a] -> [Page a]
- Hakyll.Web.Page.Metadata: changeField :: String -> (String -> String) -> Page a -> Page a
- Hakyll.Web.Page.Metadata: comparePagesByDate :: Page a -> Page a -> Ordering
- Hakyll.Web.Page.Metadata: copyBodyFromField :: String -> Page String -> Page String
- Hakyll.Web.Page.Metadata: copyBodyToField :: String -> Page String -> Page String
- Hakyll.Web.Page.Metadata: copyField :: String -> String -> Page a -> Page a
- Hakyll.Web.Page.Metadata: getField :: String -> Page a -> String
- Hakyll.Web.Page.Metadata: getFieldMaybe :: String -> Page a -> Maybe String
- Hakyll.Web.Page.Metadata: renderDateField :: String -> String -> String -> Page a -> Page a
- Hakyll.Web.Page.Metadata: renderDateFieldWith :: TimeLocale -> String -> String -> String -> Page a -> Page a
- Hakyll.Web.Page.Metadata: renderField :: String -> String -> (String -> String) -> Page a -> Page a
- Hakyll.Web.Page.Metadata: renderModificationTime :: String -> String -> Compiler (Page String) (Page String)
- Hakyll.Web.Page.Metadata: renderModificationTimeWith :: TimeLocale -> String -> String -> Compiler (Page String) (Page String)
- Hakyll.Web.Page.Metadata: setField :: String -> String -> Page a -> Page a
- Hakyll.Web.Page.Metadata: setFieldA :: Arrow a => String -> a x String -> a (Page b, x) (Page b)
- Hakyll.Web.Page.Metadata: setFieldPage :: String -> Identifier (Page String) -> Compiler (Page a) (Page a)
- Hakyll.Web.Page.Metadata: trySetField :: String -> String -> Page a -> Page a
- Hakyll.Web.Page.Read: readPage :: String -> Page String
- Hakyll.Web.Pandoc: pageReadPandoc :: Compiler (Page String) (Page Pandoc)
- Hakyll.Web.Pandoc: pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)
- Hakyll.Web.Pandoc: pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc)
- Hakyll.Web.Pandoc: pageRenderPandoc :: Compiler (Page String) (Page String)
- Hakyll.Web.Pandoc: pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler (Page String) (Page String)
- Hakyll.Web.Pandoc.Biblio: pageReadPandocBiblio :: ParserState -> Identifier CSL -> Identifier Biblio -> Compiler (Page String) (Page Pandoc)
- Hakyll.Web.Pandoc.FileType: getFileType :: Compiler a FileType
- Hakyll.Web.Tags: Tags :: [(String, [Page a])] -> Tags a
- Hakyll.Web.Tags: instance Binary a => Binary (Tags a)
- Hakyll.Web.Tags: instance Show a => Show (Tags a)
- Hakyll.Web.Tags: instance Typeable1 Tags
- Hakyll.Web.Tags: instance Writable (Tags a)
- Hakyll.Web.Tags: readCategory :: [Page a] -> Tags a
- Hakyll.Web.Tags: readTags :: [Page a] -> Tags a
- Hakyll.Web.Tags: readTagsWith :: (Page a -> [String]) -> [Page a] -> Tags a
- Hakyll.Web.Tags: renderCategoryField :: String -> (String -> Identifier a) -> Compiler (Page a) (Page a)
- Hakyll.Web.Tags: renderTagsField :: String -> (String -> Identifier a) -> Compiler (Page a) (Page a)
- Hakyll.Web.Tags: renderTagsFieldWith :: (Page a -> [String]) -> String -> (String -> Identifier a) -> Compiler (Page a) (Page a)
- Hakyll.Web.Tags: tagsMap :: Tags a -> [(String, [Page a])]
- Hakyll.Web.Template: applySelf :: Page String -> Page String
- Hakyll.Web.Template: applyTemplateCompiler :: Identifier Template -> Compiler (Page String) (Page String)
- Hakyll.Web.Template: applyTemplateCompilerWith :: (String -> String) -> Identifier Template -> Compiler (Page String) (Page String)
- Hakyll.Web.Template: templateCompilerWith :: HamletSettings -> Compiler Resource Template
- Hakyll.Web.Template.Read: readHamletTemplate :: String -> Template
- Hakyll.Web.Template.Read: readHamletTemplateWith :: HamletSettings -> String -> Template
- Hakyll.Web.Urls: isExternal :: String -> Bool
- Hakyll.Web.Urls: toSiteRoot :: String -> String
- Hakyll.Web.Urls: toUrl :: FilePath -> String
- Hakyll.Web.Urls: withUrls :: (String -> String) -> String -> String
- Hakyll.Web.Urls.Relativize: relativizeUrls :: String -> String -> String
- Hakyll.Web.Urls.Relativize: relativizeUrlsCompiler :: Compiler (Page String) (Page String)
- Hakyll.Web.Util.Html: escapeHtml :: String -> String
- Hakyll.Web.Util.Html: stripTags :: String -> String
+ Hakyll: getRecursiveContents :: FilePath -> IO [FilePath]
+ Hakyll: makeDirectories :: FilePath -> IO ()
+ Hakyll: removeDirectory :: FilePath -> IO ()
+ Hakyll.Core.Compiler: debugCompiler :: String -> Compiler ()
+ Hakyll.Core.Compiler: getResourceBody :: Compiler (Item String)
+ Hakyll.Core.Compiler: getUnderlying :: Compiler Identifier
+ Hakyll.Core.Compiler: getUnderlyingExtension :: Compiler String
+ Hakyll.Core.Compiler: load :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
+ Hakyll.Core.Compiler: loadAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
+ Hakyll.Core.Compiler: loadAllSnapshots :: (Binary a, Typeable a) => Pattern -> Snapshot -> Compiler [Item a]
+ Hakyll.Core.Compiler: loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a
+ Hakyll.Core.Compiler: loadSnapshot :: (Binary a, Typeable a) => Identifier -> Snapshot -> Compiler (Item a)
+ Hakyll.Core.Compiler: loadSnapshotBody :: (Binary a, Typeable a) => Identifier -> Snapshot -> Compiler a
+ Hakyll.Core.Compiler: makeItem :: a -> Compiler (Item a)
+ Hakyll.Core.Compiler: saveSnapshot :: (Binary a, Typeable a) => Snapshot -> Item a -> Compiler (Item a)
+ Hakyll.Core.Compiler: type Snapshot = String
+ Hakyll.Core.Configuration: Configuration :: FilePath -> FilePath -> FilePath -> FilePath -> (FilePath -> Bool) -> String -> Bool -> Configuration
+ Hakyll.Core.Configuration: data Configuration
+ Hakyll.Core.Configuration: defaultConfiguration :: Configuration
+ Hakyll.Core.Configuration: providerDirectory :: Configuration -> FilePath
+ Hakyll.Core.Configuration: tmpDirectory :: Configuration -> FilePath
+ Hakyll.Core.Dependencies: IdentifierDependency :: Identifier -> Dependency
+ Hakyll.Core.Dependencies: PatternDependency :: Pattern -> [Identifier] -> Dependency
+ Hakyll.Core.Dependencies: data Dependency
+ Hakyll.Core.Dependencies: instance Binary Dependency
+ Hakyll.Core.Dependencies: instance Show Dependency
+ Hakyll.Core.Dependencies: instance Show DependencyState
+ Hakyll.Core.Dependencies: instance Typeable Dependency
+ Hakyll.Core.Dependencies: outOfDate :: [Identifier] -> Set Identifier -> DependencyFacts -> (Set Identifier, DependencyFacts, [String])
+ Hakyll.Core.Dependencies: type DependencyFacts = Map Identifier [Dependency]
+ Hakyll.Core.File: CopyFile :: CopyFile
+ Hakyll.Core.File: TmpFile :: FilePath -> TmpFile
+ Hakyll.Core.File: copyFileCompiler :: Compiler (Item CopyFile)
+ Hakyll.Core.File: data CopyFile
+ Hakyll.Core.File: instance Binary CopyFile
+ Hakyll.Core.File: instance Binary TmpFile
+ Hakyll.Core.File: instance Eq CopyFile
+ Hakyll.Core.File: instance Ord CopyFile
+ Hakyll.Core.File: instance Show CopyFile
+ Hakyll.Core.File: instance Typeable CopyFile
+ Hakyll.Core.File: instance Typeable TmpFile
+ Hakyll.Core.File: instance Writable CopyFile
+ Hakyll.Core.File: instance Writable TmpFile
+ Hakyll.Core.File: newTmpFile :: String -> Compiler TmpFile
+ Hakyll.Core.File: newtype TmpFile
+ Hakyll.Core.Identifier: fromFilePath :: String -> Identifier
+ Hakyll.Core.Identifier: identifierVersion :: Identifier -> Maybe String
+ Hakyll.Core.Identifier: instance Binary Identifier
+ Hakyll.Core.Identifier: instance Eq Identifier
+ Hakyll.Core.Identifier: instance IsString Identifier
+ Hakyll.Core.Identifier: instance NFData Identifier
+ Hakyll.Core.Identifier: instance Ord Identifier
+ Hakyll.Core.Identifier: instance Show Identifier
+ Hakyll.Core.Identifier: instance Typeable Identifier
+ Hakyll.Core.Identifier: setVersion :: Maybe String -> Identifier -> Identifier
+ Hakyll.Core.Identifier.Pattern: (.&&.) :: Pattern -> Pattern -> Pattern
+ Hakyll.Core.Identifier.Pattern: (.||.) :: Pattern -> Pattern -> Pattern
+ Hakyll.Core.Identifier.Pattern: fromGlob :: String -> Pattern
+ Hakyll.Core.Identifier.Pattern: fromList :: [Identifier] -> Pattern
+ Hakyll.Core.Identifier.Pattern: fromRegex :: String -> Pattern
+ Hakyll.Core.Identifier.Pattern: fromVersion :: Maybe String -> Pattern
+ Hakyll.Core.Identifier.Pattern: hasNoVersion :: Pattern
+ Hakyll.Core.Identifier.Pattern: hasVersion :: String -> Pattern
+ Hakyll.Core.Identifier.Pattern: instance Binary GlobComponent
+ Hakyll.Core.Identifier.Pattern: instance Binary Pattern
+ Hakyll.Core.Identifier.Pattern: instance IsString Pattern
+ Hakyll.Core.Identifier.Pattern: instance Monoid Pattern
+ Hakyll.Core.Identifier.Pattern: instance Show Pattern
+ Hakyll.Core.Item: Item :: Identifier -> a -> Item a
+ Hakyll.Core.Item: data Item a
+ Hakyll.Core.Item: instance Binary a => Binary (Item a)
+ Hakyll.Core.Item: instance Foldable Item
+ Hakyll.Core.Item: instance Functor Item
+ Hakyll.Core.Item: instance Show a => Show (Item a)
+ Hakyll.Core.Item: instance Traversable Item
+ Hakyll.Core.Item: instance Typeable1 Item
+ Hakyll.Core.Item: itemBody :: Item a -> a
+ Hakyll.Core.Item: itemIdentifier :: Item a -> Identifier
+ Hakyll.Core.Item: itemSetBody :: a -> Item b -> Item a
+ Hakyll.Core.Item: withItemBody :: (a -> Compiler b) -> Item a -> Compiler (Item b)
+ Hakyll.Core.Metadata: class Monad m => MonadMetadata m where getAllMetadata pattern = do { matches' <- getMatches pattern; forM matches' $ \ id' -> do { metadata <- getMetadata id'; return (id', metadata) } }
+ Hakyll.Core.Metadata: getAllMetadata :: MonadMetadata m => Pattern -> m [(Identifier, Metadata)]
+ Hakyll.Core.Metadata: getMatches :: MonadMetadata m => Pattern -> m [Identifier]
+ Hakyll.Core.Metadata: getMetadata :: MonadMetadata m => Identifier -> m Metadata
+ Hakyll.Core.Metadata: type Metadata = Map String String
+ Hakyll.Core.Rules: IdentifierDependency :: Identifier -> Dependency
+ Hakyll.Core.Rules: PatternDependency :: Pattern -> [Identifier] -> Dependency
+ Hakyll.Core.Rules: data Dependency
+ Hakyll.Core.Rules: data Rules a
+ Hakyll.Core.Rules: preprocess :: IO a -> Rules a
+ Hakyll.Core.Rules: rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a
+ Hakyll.Core.Rules: version :: String -> Rules () -> Rules ()
+ Hakyll.Main: instance Data HakyllArgs
+ Hakyll.Main: instance Show HakyllArgs
+ Hakyll.Main: instance Typeable HakyllArgs
+ Hakyll.Web.Html: demoteHeaders :: String -> String
+ Hakyll.Web.Html: escapeHtml :: String -> String
+ Hakyll.Web.Html: getUrls :: [Tag String] -> [String]
+ Hakyll.Web.Html: isExternal :: String -> Bool
+ Hakyll.Web.Html: stripTags :: String -> String
+ Hakyll.Web.Html: toSiteRoot :: String -> String
+ Hakyll.Web.Html: toUrl :: FilePath -> String
+ Hakyll.Web.Html: withTags :: (Tag String -> Tag String) -> String -> String
+ Hakyll.Web.Html: withUrls :: (String -> String) -> String -> String
+ Hakyll.Web.Html.RelativizeUrls: relativizeUrls :: Item String -> Compiler (Item String)
+ Hakyll.Web.Html.RelativizeUrls: relativizeUrlsWith :: String -> String -> String
+ Hakyll.Web.Pandoc: pandocCompiler :: Compiler (Item String)
+ Hakyll.Web.Pandoc: pandocCompilerWith :: ParserState -> WriterOptions -> Compiler (Item String)
+ Hakyll.Web.Pandoc: pandocCompilerWithTransform :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) -> Compiler (Item String)
+ Hakyll.Web.Pandoc: renderPandoc :: Item String -> Item String
+ Hakyll.Web.Pandoc: renderPandocWith :: ParserState -> WriterOptions -> Item String -> Item String
+ Hakyll.Web.Pandoc.Biblio: readPandocBiblio :: ParserState -> Item CSL -> Item Biblio -> (Item String) -> Compiler (Item Pandoc)
+ Hakyll.Web.Pandoc.FileType: itemFileType :: Item a -> FileType
+ Hakyll.Web.Tags: buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags
+ Hakyll.Web.Tags: buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags
+ Hakyll.Web.Tags: buildTagsWith :: MonadMetadata m => (Identifier -> m [String]) -> Pattern -> (String -> Identifier) -> m Tags
+ Hakyll.Web.Tags: categoryField :: String -> Tags -> Context a
+ Hakyll.Web.Tags: instance Show Tags
+ Hakyll.Web.Tags: tagsField :: String -> Tags -> Context a
+ Hakyll.Web.Tags: tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()
+ Hakyll.Web.Template: applyAsTemplate :: Context String -> Item String -> Compiler (Item String)
+ Hakyll.Web.Template: loadAndApplyTemplate :: Identifier -> Context a -> Item a -> Compiler (Item String)
+ Hakyll.Web.Template.Context: Context :: (String -> Item a -> Compiler String) -> Context a
+ Hakyll.Web.Template.Context: bodyField :: String -> Context String
+ Hakyll.Web.Template.Context: constField :: String -> String -> Context a
+ Hakyll.Web.Template.Context: dateField :: String -> String -> Context a
+ Hakyll.Web.Template.Context: dateFieldWith :: TimeLocale -> String -> String -> Context a
+ Hakyll.Web.Template.Context: defaultContext :: Context String
+ Hakyll.Web.Template.Context: field :: String -> (Item a -> Compiler String) -> Context a
+ Hakyll.Web.Template.Context: functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a
+ Hakyll.Web.Template.Context: getItemUTC :: TimeLocale -> Identifier -> Compiler UTCTime
+ Hakyll.Web.Template.Context: instance Monoid (Context a)
+ Hakyll.Web.Template.Context: mapContext :: (String -> String) -> Context a -> Context a
+ Hakyll.Web.Template.Context: metadataField :: Context String
+ Hakyll.Web.Template.Context: missingField :: Context a
+ Hakyll.Web.Template.Context: modificationTimeField :: String -> String -> Context a
+ Hakyll.Web.Template.Context: modificationTimeFieldWith :: TimeLocale -> String -> String -> Context a
+ Hakyll.Web.Template.Context: newtype Context a
+ Hakyll.Web.Template.Context: pathField :: String -> Context a
+ Hakyll.Web.Template.Context: titleField :: String -> Context a
+ Hakyll.Web.Template.Context: unContext :: Context a -> String -> Item a -> Compiler String
+ Hakyll.Web.Template.Context: urlField :: String -> Context a
+ Hakyll.Web.Template.List: applyJoinTemplateList :: String -> Template -> Context a -> [Item a] -> Compiler String
+ Hakyll.Web.Template.List: applyTemplateList :: Template -> Context a -> [Item a] -> Compiler String
+ Hakyll.Web.Template.List: chronological :: [Item a] -> [Item a]
+ Hakyll.Web.Template.List: recentFirst :: [Item a] -> [Item a]
- Hakyll.Core.Compiler: cached :: (Binary a, Typeable a, Writable a) => String -> Compiler Resource a -> Compiler Resource a
+ Hakyll.Core.Compiler: cached :: (Binary a, Typeable a) => String -> Compiler a -> Compiler a
- Hakyll.Core.Compiler: data Compiler a b
+ Hakyll.Core.Compiler: data Compiler a
- Hakyll.Core.Compiler: getResourceLBS :: Compiler Resource ByteString
+ Hakyll.Core.Compiler: getResourceLBS :: Compiler (Item ByteString)
- Hakyll.Core.Compiler: getResourceString :: Compiler Resource String
+ Hakyll.Core.Compiler: getResourceString :: Compiler (Item String)
- Hakyll.Core.Compiler: getResourceWith :: (ResourceProvider -> Resource -> IO a) -> Compiler Resource a
+ Hakyll.Core.Compiler: getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)
- Hakyll.Core.Compiler: getRoute :: Compiler a (Maybe FilePath)
+ Hakyll.Core.Compiler: getRoute :: Identifier -> Compiler (Maybe FilePath)
- Hakyll.Core.Compiler: unsafeCompiler :: (a -> IO b) -> Compiler a b
+ Hakyll.Core.Compiler: unsafeCompiler :: IO a -> Compiler a
- Hakyll.Core.Configuration: deployCommand :: HakyllConfiguration -> String
+ Hakyll.Core.Configuration: deployCommand :: Configuration -> String
- Hakyll.Core.Configuration: destinationDirectory :: HakyllConfiguration -> FilePath
+ Hakyll.Core.Configuration: destinationDirectory :: Configuration -> FilePath
- Hakyll.Core.Configuration: ignoreFile :: HakyllConfiguration -> FilePath -> Bool
+ Hakyll.Core.Configuration: ignoreFile :: Configuration -> FilePath -> Bool
- Hakyll.Core.Configuration: inMemoryCache :: HakyllConfiguration -> Bool
+ Hakyll.Core.Configuration: inMemoryCache :: Configuration -> Bool
- Hakyll.Core.Configuration: shouldIgnoreFile :: HakyllConfiguration -> FilePath -> Bool
+ Hakyll.Core.Configuration: shouldIgnoreFile :: Configuration -> FilePath -> Bool
- Hakyll.Core.Configuration: storeDirectory :: HakyllConfiguration -> FilePath
+ Hakyll.Core.Configuration: storeDirectory :: Configuration -> FilePath
- Hakyll.Core.Identifier: data Identifier a
+ Hakyll.Core.Identifier: data Identifier
- Hakyll.Core.Identifier: toFilePath :: Identifier a -> FilePath
+ Hakyll.Core.Identifier: toFilePath :: Identifier -> FilePath
- Hakyll.Core.Identifier.Pattern: capture :: Pattern a -> Identifier a -> Maybe [String]
+ Hakyll.Core.Identifier.Pattern: capture :: Pattern -> Identifier -> Maybe [String]
- Hakyll.Core.Identifier.Pattern: complement :: Pattern a -> Pattern a
+ Hakyll.Core.Identifier.Pattern: complement :: Pattern -> Pattern
- Hakyll.Core.Identifier.Pattern: data Pattern a
+ Hakyll.Core.Identifier.Pattern: data Pattern
- Hakyll.Core.Identifier.Pattern: filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]
+ Hakyll.Core.Identifier.Pattern: filterMatches :: Pattern -> [Identifier] -> [Identifier]
- Hakyll.Core.Identifier.Pattern: fromCapture :: Pattern a -> String -> Identifier a
+ Hakyll.Core.Identifier.Pattern: fromCapture :: Pattern -> String -> Identifier
- Hakyll.Core.Identifier.Pattern: fromCaptures :: Pattern a -> [String] -> Identifier a
+ Hakyll.Core.Identifier.Pattern: fromCaptures :: Pattern -> [String] -> Identifier
- Hakyll.Core.Identifier.Pattern: matches :: Pattern a -> Identifier a -> Bool
+ Hakyll.Core.Identifier.Pattern: matches :: Pattern -> Identifier -> Bool
- Hakyll.Core.Routes: customRoute :: (Identifier a -> FilePath) -> Routes
+ Hakyll.Core.Routes: customRoute :: (Identifier -> FilePath) -> Routes
- Hakyll.Core.Routes: matchRoute :: Pattern a -> Routes -> Routes
+ Hakyll.Core.Routes: matchRoute :: Pattern -> Routes -> Routes
- Hakyll.Core.Routes: runRoutes :: Routes -> Identifier a -> Maybe FilePath
+ Hakyll.Core.Routes: runRoutes :: Routes -> Identifier -> Maybe FilePath
- Hakyll.Core.Rules: compile :: (Binary a, Typeable a, Writable a) => Compiler Resource a -> RulesM (Pattern a)
+ Hakyll.Core.Rules: compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()
- Hakyll.Core.Rules: create :: (Binary a, Typeable a, Writable a) => Identifier a -> Compiler () a -> RulesM (Identifier a)
+ Hakyll.Core.Rules: create :: [Identifier] -> Rules () -> Rules ()
- Hakyll.Core.Rules: match :: Pattern a -> RulesM b -> RulesM b
+ Hakyll.Core.Rules: match :: Pattern -> Rules () -> Rules ()
- Hakyll.Core.Rules: route :: Routes -> Rules
+ Hakyll.Core.Rules: route :: Routes -> Rules ()
- Hakyll.Core.UnixFilter: unixFilter :: String -> [String] -> Compiler String String
+ Hakyll.Core.UnixFilter: unixFilter :: String -> [String] -> String -> Compiler String
- Hakyll.Core.UnixFilter: unixFilterLBS :: String -> [String] -> Compiler ByteString ByteString
+ Hakyll.Core.UnixFilter: unixFilterLBS :: String -> [String] -> ByteString -> Compiler ByteString
- Hakyll.Core.Writable: write :: Writable a => FilePath -> a -> IO ()
+ Hakyll.Core.Writable: write :: Writable a => FilePath -> Item a -> IO ()
- Hakyll.Main: hakyll :: RulesM a -> IO ()
+ Hakyll.Main: hakyll :: Rules a -> IO ()
- Hakyll.Main: hakyllWith :: HakyllConfiguration -> RulesM a -> IO ()
+ Hakyll.Main: hakyllWith :: Configuration -> Rules a -> IO ()
- Hakyll.Web.CompressCss: compressCssCompiler :: Compiler Resource String
+ Hakyll.Web.CompressCss: compressCssCompiler :: Compiler (Item String)
- Hakyll.Web.Feed: renderAtom :: FeedConfiguration -> Compiler [Page String] String
+ Hakyll.Web.Feed: renderAtom :: FeedConfiguration -> Context String -> [Item String] -> Compiler (Item String)
- Hakyll.Web.Feed: renderRss :: FeedConfiguration -> Compiler [Page String] String
+ Hakyll.Web.Feed: renderRss :: FeedConfiguration -> Context String -> [Item String] -> Compiler (Item String)
- Hakyll.Web.Pandoc: readPandoc :: FileType -> Maybe (Identifier a) -> String -> Pandoc
+ Hakyll.Web.Pandoc: readPandoc :: Item String -> Item Pandoc
- Hakyll.Web.Pandoc: readPandocWith :: ParserState -> FileType -> Maybe (Identifier a) -> String -> Pandoc
+ Hakyll.Web.Pandoc: readPandocWith :: ParserState -> Item String -> Item Pandoc
- Hakyll.Web.Pandoc: writePandoc :: Pandoc -> String
+ Hakyll.Web.Pandoc: writePandoc :: Item Pandoc -> Item String
- Hakyll.Web.Pandoc: writePandocWith :: WriterOptions -> Pandoc -> String
+ Hakyll.Web.Pandoc: writePandocWith :: WriterOptions -> Item Pandoc -> Item String
- Hakyll.Web.Pandoc.Biblio: biblioCompiler :: Compiler Resource Biblio
+ Hakyll.Web.Pandoc.Biblio: biblioCompiler :: Compiler (Item Biblio)
- Hakyll.Web.Pandoc.Biblio: cslCompiler :: Compiler Resource CSL
+ Hakyll.Web.Pandoc.Biblio: cslCompiler :: Compiler (Item CSL)
- Hakyll.Web.Tags: caseInsensitiveTags :: (String, [Page a]) -> (String, [Page a]) -> Ordering
+ Hakyll.Web.Tags: caseInsensitiveTags :: (String, [Identifier]) -> (String, [Identifier]) -> Ordering
- Hakyll.Web.Tags: data Tags a
+ Hakyll.Web.Tags: data Tags
- Hakyll.Web.Tags: getTags :: Page a -> [String]
+ Hakyll.Web.Tags: getTags :: MonadMetadata m => Identifier -> m [String]
- Hakyll.Web.Tags: renderTagCloud :: (String -> Identifier (Page a)) -> Double -> Double -> Compiler (Tags a) String
+ Hakyll.Web.Tags: renderTagCloud :: Double -> Double -> Tags -> Compiler String
- Hakyll.Web.Tags: renderTagList :: (String -> Identifier (Page a)) -> Compiler (Tags a) (String)
+ Hakyll.Web.Tags: renderTagList :: Tags -> Compiler (String)
- Hakyll.Web.Tags: sortTagsBy :: ((String, [Page a]) -> (String, [Page a]) -> Ordering) -> Compiler (Tags a) (Tags a)
+ Hakyll.Web.Tags: sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering) -> Tags -> Tags
- Hakyll.Web.Template: applyTemplate :: Template -> Page String -> Page String
+ Hakyll.Web.Template: applyTemplate :: Template -> Context a -> Item a -> Compiler (Item String)
- Hakyll.Web.Template: applyTemplateWith :: (String -> String) -> Template -> Page String -> Page String
+ Hakyll.Web.Template: applyTemplateWith :: Monad m => (String -> a -> m String) -> Template -> a -> m String
- Hakyll.Web.Template: templateCompiler :: Compiler Resource Template
+ Hakyll.Web.Template: templateCompiler :: Compiler (Item Template)
Files
- data/example/about.rst +17/−0
- data/example/contact.markdown +6/−0
- data/example/css/default.css +56/−0
- data/example/images/haskell-logo.png binary
- data/example/index.html +19/−0
- data/example/posts/2012-08-12-spqr.markdown +59/−0
- data/example/posts/2012-10-07-rosa-rosa-rosam.markdown +45/−0
- data/example/posts/2012-11-28-carpe-diem.markdown +50/−0
- data/example/posts/2012-12-07-tu-quoque.markdown +57/−0
- data/example/site.hs +72/−0
- data/example/templates/archive.html +3/−0
- data/example/templates/default.html +33/−0
- data/example/templates/post-item.html +3/−0
- data/example/templates/post.html +3/−0
- hakyll.cabal +79/−49
- src/Hakyll.hs +36/−46
- src/Hakyll/Check.hs +199/−0
- src/Hakyll/Commands.hs +129/−0
- src/Hakyll/Core/CompiledItem.hs +0/−47
- src/Hakyll/Core/Compiler.hs +117/−354
- src/Hakyll/Core/Compiler/Internal.hs +200/−124
- src/Hakyll/Core/Compiler/Require.hs +128/−0
- src/Hakyll/Core/Configuration.hs +39/−23
- src/Hakyll/Core/Dependencies.hs +147/−0
- src/Hakyll/Core/DependencyAnalyzer.hs +0/−156
- src/Hakyll/Core/DirectedGraph.hs +0/−84
- src/Hakyll/Core/DirectedGraph/Dot.hs +0/−32
- src/Hakyll/Core/DirectedGraph/Internal.hs +0/−52
- src/Hakyll/Core/File.hs +89/−0
- src/Hakyll/Core/Identifier.hs +54/−69
- src/Hakyll/Core/Identifier/Pattern.hs +198/−97
- src/Hakyll/Core/Item.hs +65/−0
- src/Hakyll/Core/Item/SomeItem.hs +23/−0
- src/Hakyll/Core/Logger.hs +68/−70
- src/Hakyll/Core/Metadata.hs +32/−0
- src/Hakyll/Core/Provider.hs +46/−0
- src/Hakyll/Core/Provider/Internal.hs +94/−0
- src/Hakyll/Core/Provider/Metadata.hs +125/−0
- src/Hakyll/Core/Provider/MetadataCache.hs +68/−0
- src/Hakyll/Core/Provider/Modified.hs +101/−0
- src/Hakyll/Core/Resource.hs +0/−31
- src/Hakyll/Core/Resource/Provider.hs +0/−125
- src/Hakyll/Core/Resource/Provider/Dummy.hs +0/−25
- src/Hakyll/Core/Resource/Provider/File.hs +0/−39
- src/Hakyll/Core/Routes.hs +36/−20
- src/Hakyll/Core/Rules.hs +139/−206
- src/Hakyll/Core/Rules/Internal.hs +78/−67
- src/Hakyll/Core/Run.hs +0/−217
- src/Hakyll/Core/Runtime.hs +250/−0
- src/Hakyll/Core/Store.hs +8/−6
- src/Hakyll/Core/UnixFilter.hs +42/−31
- src/Hakyll/Core/Util/Arrow.hs +0/−25
- src/Hakyll/Core/Util/File.hs +36/−44
- src/Hakyll/Core/Writable.hs +32/−18
- src/Hakyll/Core/Writable/CopyFile.hs +0/−29
- src/Hakyll/Core/Writable/WritableTuple.hs +0/−37
- src/Hakyll/Init.hs +37/−0
- src/Hakyll/Main.hs +81/−128
- src/Hakyll/Preview/Poll.hs +48/−0
- src/Hakyll/Preview/Server.hs +43/−0
- src/Hakyll/Web/Blaze.hs +0/−35
- src/Hakyll/Web/CompressCss.hs +32/−23
- src/Hakyll/Web/Feed.hs +79/−83
- src/Hakyll/Web/Html.hs +155/−0
- src/Hakyll/Web/Html/RelativizeUrls.hs +52/−0
- src/Hakyll/Web/Page.hs +0/−156
- src/Hakyll/Web/Page/Internal.hs +0/−50
- src/Hakyll/Web/Page/List.hs +0/−82
- src/Hakyll/Web/Page/Metadata.hs +0/−235
- src/Hakyll/Web/Page/Read.hs +0/−61
- src/Hakyll/Web/Pandoc.hs +83/−77
- src/Hakyll/Web/Pandoc/Biblio.hs +67/−38
- src/Hakyll/Web/Pandoc/FileType.hs +17/−11
- src/Hakyll/Web/Preview/Poll.hs +0/−43
- src/Hakyll/Web/Preview/Server.hs +0/−40
- src/Hakyll/Web/Tags.hs +178/−137
- src/Hakyll/Web/Template.hs +72/−100
- src/Hakyll/Web/Template/Context.hs +219/−0
- src/Hakyll/Web/Template/Internal.hs +18/−8
- src/Hakyll/Web/Template/List.hs +66/−0
- src/Hakyll/Web/Template/Read.hs +37/−6
- src/Hakyll/Web/Template/Read/Hakyll.hs +0/−35
- src/Hakyll/Web/Template/Read/Hamlet.hs +0/−46
- src/Hakyll/Web/Urls.hs +0/−66
- src/Hakyll/Web/Urls/Relativize.hs +0/−48
- src/Hakyll/Web/Util/Html.hs +0/−47
- tests/Hakyll/Core/Compiler/Tests.hs +0/−36
- tests/Hakyll/Core/Dependencies/Tests.hs +70/−0
- tests/Hakyll/Core/DependencyAnalyzer/Tests.hs +0/−70
- tests/Hakyll/Core/Identifier/Tests.hs +25/−11
- tests/Hakyll/Core/Provider/Tests.hs +39/−0
- tests/Hakyll/Core/Routes/Tests.hs +14/−7
- tests/Hakyll/Core/Rules/Tests.hs +70/−55
- tests/Hakyll/Core/Runtime/Tests.hs +50/−0
- tests/Hakyll/Core/Store/Tests.hs +27/−26
- tests/Hakyll/Core/UnixFilter/Tests.hs +27/−38
- tests/Hakyll/Core/Util/Arrow/Tests.hs +0/−14
- tests/Hakyll/Core/Util/String/Tests.hs +13/−6
- tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs +34/−0
- tests/Hakyll/Web/Html/Tests.hs +71/−0
- tests/Hakyll/Web/Page/Metadata/Tests.hs +0/−77
- tests/Hakyll/Web/Page/Tests.hs +0/−40
- tests/Hakyll/Web/Template/Context/Tests.hs +54/−0
- tests/Hakyll/Web/Template/Tests.hs +55/−41
- tests/Hakyll/Web/Urls/Relativize/Tests.hs +0/−25
- tests/Hakyll/Web/Urls/Tests.hs +0/−46
- tests/Hakyll/Web/Util/Html/Tests.hs +0/−22
- tests/TestSuite.hs +30/−40
- tests/TestSuite/Util.hs +90/−32
- tests/data/example.md +5/−0
- tests/data/example.md.metadata +2/−0
- tests/data/template.html +5/−0
- tests/data/template.html.out +5/−0
+ data/example/about.rst view
@@ -0,0 +1,17 @@+---+title: About+---+Nullam imperdiet sodales orci vitae molestie. Nunc quam orci, pharetra a+rhoncus vitae, eleifend id felis. Suspendisse potenti. Etiam vitae urna orci.+Quisque pellentesque dignissim felis, egestas tempus urna luctus vitae. In hac+habitasse platea dictumst. Morbi fringilla mattis odio, et mattis tellus+accumsan vitae.++1. Amamus Unicode 碁+2. Interdum nex magna.++Vivamus eget mauris sit amet nulla laoreet lobortis. Nulla in diam elementum+risus convallis commodo. Cras vehicula varius dui vitae facilisis. Proin+elementum libero eget leo aliquet quis euismod orci vestibulum. Duis rhoncus+lorem consequat tellus vestibulum aliquam. Quisque orci orci, malesuada porta+blandit et, interdum nec magna.
+ data/example/contact.markdown view
@@ -0,0 +1,6 @@+---+title: Contact+---++I live in a small hut in the mountains of Kumano Kodō on Kii Hantō and would not+like to be contacted.
+ data/example/css/default.css view
@@ -0,0 +1,56 @@+body {+ color: black;+ font-size: 16px;+ margin: 0px auto 0px auto;+ width: 600px;+}++div#header {+ border-bottom: 2px solid black;+ margin-bottom: 30px;+ padding: 12px 0px 12px 0px;+}++div#logo a {+ color: black;+ float: left;+ font-size: 18px;+ font-weight: bold;+ text-decoration: none;+}++div#header #navigation {+ text-align: right;+}++div#header #navigation a {+ color: black;+ font-size: 18px;+ font-weight: bold;+ margin-left: 12px;+ text-decoration: none;+ text-transform: uppercase;+}++div#footer {+ border-top: solid 2px black;+ color: #555;+ font-size: 12px;+ margin-top: 30px;+ padding: 12px 0px 12px 0px;+ text-align: right;+}++h1 {+ font-size: 24px;+}++h2 {+ font-size: 20px;+}++div.info {+ color: #555;+ font-size: 14px;+ font-style: italic;+}
+ data/example/images/haskell-logo.png view
binary file changed (absent → 5674 bytes)
+ data/example/index.html view
@@ -0,0 +1,19 @@+---+title: Home+---++<h2>Welcome</h2>++<img src="/images/haskell-logo.png" style="float: right; margin: 10px;" />++<p>Welcome to my blog!</p>++<p>I've reproduced a list of recent posts here for your reading pleasure:</p>++<h2>Posts</h2>++<ul>+ $posts$+</ul>++<p>…or you can find more in the <a href="/archive.html">archives</a>.
+ data/example/posts/2012-08-12-spqr.markdown view
@@ -0,0 +1,59 @@+---+title: S.P.Q.R.+---++Mauris in lorem nisl. Maecenas tempus facilisis ante, eget viverra nisl+tincidunt et. Donec turpis lectus, mattis ac malesuada a, accumsan eu libero.+Morbi condimentum, tortor et tincidunt ullamcorper, sem quam pretium nulla, id+convallis lectus libero nec turpis. Proin dapibus nisi id est sodales nec+ultrices tortor pellentesque. Vivamus vel nisi ac lacus sollicitudin vulputate+ac ut ligula. Nullam feugiat risus eget eros gravida in molestie sapien euismod.+Nunc sed hendrerit orci. Nulla mollis consequat lorem ac blandit. Ut et turpis+mauris. Nulla est odio, posuere id ullamcorper sit amet, tincidunt vel justo.+Curabitur placerat tincidunt varius. Nulla vulputate, ipsum eu consectetur+mollis, dui nibh aliquam neque, at ultricies leo ligula et arcu. Proin et mi+eget tellus sodales lobortis. Sed tempor, urna vel pulvinar faucibus, lectus+urna vehicula ante, at facilisis dolor odio at lorem. Morbi vehicula euismod+urna, et imperdiet urna ornare vitae.++Sed tincidunt sollicitudin ultrices. In hac habitasse platea dictumst. Morbi+ligula lectus, egestas at ultricies nec, fringilla et tellus. Duis urna lorem,+bibendum a ornare sed, euismod sed nunc. Aliquam tempor massa at velit fringilla+fringilla. Praesent sit amet tempor felis. Maecenas id felis ac velit aliquam+tempor a sit amet orci. Nunc placerat nulla pellentesque sem commodo cursus.+Praesent quis sapien orci, quis ultricies augue. Nam vestibulum sem non augue+semper tincidunt pellentesque ipsum volutpat. Duis congue, nunc a aliquam+luctus, quam ante convallis nisi, ac pellentesque lacus orci vel turpis. Cum+sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus+mus. Suspendisse hendrerit nisl eu felis sagittis faucibus. Nunc eu congue+lorem. Quisque non nibh nisi, et ultrices massa. Sed vitae erat vitae nulla+pellentesque fermentum.++Ut diam nunc, consectetur ut ultrices eu, iaculis sed felis. Sed lacinia, odio+et accumsan luctus, arcu ipsum accumsan erat, sit amet malesuada libero lacus et+velit. Donec accumsan tristique tristique. Proin a metus magna, vitae mattis+nisl. Integer a libero ipsum. Mauris faucibus eleifend metus id sodales. Morbi+ornare, nibh nec facilisis imperdiet, turpis sem commodo lorem, id commodo+mauris metus vitae justo. Etiam at pellentesque tortor. Proin mollis accumsan+ligula, nec tempus augue auctor quis. Nulla lacinia, mi quis lobortis auctor,+nisi diam posuere dui, pulvinar feugiat dui libero eget quam. Fusce eu risus+nunc, a consectetur orci. Class aptent taciti sociosqu ad litora torquent per+conubia nostra, per inceptos himenaeos. Maecenas venenatis aliquet orci, a+ultricies sem facilisis eu. Donec dolor purus, porta condimentum convallis nec,+dignissim nec libero.++Etiam rutrum ultricies dui, et interdum metus elementum et. Nulla sapien nunc,+interdum tristique porttitor in, laoreet vitae mi. Ut vehicula auctor mauris sit+amet bibendum. Phasellus adipiscing mattis libero, eget adipiscing erat+dignissim at. Vivamus convallis malesuada metus nec cursus. Ut cursus, lorem+eleifend sollicitudin condimentum, felis tortor sodales augue, ac tempus lacus+ipsum vitae quam. Vestibulum vitae lacus non tortor vehicula iaculis faucibus+quis massa.++Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus+mus. Duis malesuada neque nec ante porttitor accumsan. Suspendisse potenti.+Aliquam in lacus magna, imperdiet laoreet lectus. Praesent id diam nec ante+commodo rhoncus nec vel augue. Pellentesque tortor massa, dignissim ut sagittis+sed, hendrerit vitae nunc. Nam gravida, urna vitae hendrerit rutrum, felis augue+vulputate tortor, ut varius velit libero nec lectus. In adipiscing massa in est+scelerisque ullamcorper. Vivamus in nisi metus.
+ data/example/posts/2012-10-07-rosa-rosa-rosam.markdown view
@@ -0,0 +1,45 @@+---+title: Rosa Rosa Rosam+---++Suspendisse pharetra ullamcorper sem et auctor. Suspendisse vitae tellus eu+turpis dignissim gravida ut ut tortor. Cum sociis natoque penatibus et magnis+dis parturient montes, nascetur ridiculus mus. Morbi aliquam sapien quis nisl+sodales non aliquet nisl iaculis. Curabitur fermentum orci vel sapien+pellentesque id condimentum metus vehicula. Curabitur turpis purus, scelerisque+at interdum quis, placerat sit amet tortor. Aliquam erat volutpat.++Integer posuere felis non arcu suscipit ullamcorper. Nam tempus risus venenatis+orci sagittis eu aliquam ante tincidunt. Aenean vehicula ipsum id sapien+tincidunt commodo. Aliquam erat volutpat. Curabitur vehicula libero ac turpis+cursus consectetur. Praesent posuere egestas purus et dapibus. Mauris egestas,+lectus vitae scelerisque ultricies, metus lorem tempor nisi, sed vehicula tortor+mauris nec urna. Quisque urna tellus, facilisis at mollis eget, adipiscing in+nisl. Proin quam arcu, euismod et imperdiet sed, ultricies sed orci.++Nulla malesuada sem eget lectus scelerisque nec rhoncus metus interdum. In dui+felis, rhoncus id scelerisque eget, vulputate id sem. Nulla facilisi. Vestibulum+eleifend, metus dignissim lacinia ornare, magna nulla vehicula nisi, sed+molestie mauris ipsum vel turpis. Class aptent taciti sociosqu ad litora+torquent per conubia nostra, per inceptos himenaeos. Nulla urna leo, vehicula+eget dignissim a, hendrerit ut risus. Fusce ultricies elementum placerat. Nam at+dolor sed nisi mollis sollicitudin vitae at urna. Vestibulum iaculis adipiscing+eros et mollis.++Phasellus ultricies elit eu risus sagittis eu dictum ante ultrices. Nulla+congue, augue ac placerat tempor, orci mi luctus nisi, at varius ipsum sem sed+eros. Vivamus eget velit eget felis posuere ornare. In sed metus non est iaculis+facilisis dapibus sit amet enim. Aliquam viverra tortor eget neque volutpat in+auctor urna rutrum. Aliquam ligula augue, congue sit amet rutrum in, semper vel+nulla. Sed tempus porttitor faucibus. Donec cursus sodales nulla, quis lacinia+mi vehicula vel. Sed nec purus orci. Nam leo sapien, rutrum a ultrices quis,+placerat vel ligula. Donec massa quam, pellentesque et molestie nec, hendrerit+id mauris. In hac habitasse platea dictumst. Cras quis quam sem. Curabitur in+arcu diam, in interdum mauris.++Proin lorem sapien, iaculis et faucibus nec, dictum sed nunc. Pellentesque in+purus justo. Vestibulum facilisis rutrum nisi, a egestas nunc suscipit sed. Ut+quis tortor a arcu bibendum placerat non sed ante. Praesent orci sem, posuere+sit amet cursus molestie, volutpat ut purus. Curabitur aliquam, purus in+pharetra viverra, lorem leo aliquam tellus, vel consequat felis neque et mauris.+Aliquam erat volutpat.
+ data/example/posts/2012-11-28-carpe-diem.markdown view
@@ -0,0 +1,50 @@+---+title: Carpe Diem+---++Fusce tortor quam, egestas in posuere quis, porttitor vel turpis. Donec+vulputate porttitor augue at rhoncus. Proin iaculis consectetur sagittis.+Curabitur venenatis turpis sit amet purus tristique nec posuere risus laoreet.+Nullam nisi sem, dapibus id semper id, egestas vel arcu. Morbi porttitor ipsum+placerat erat consequat sed consequat purus feugiat. Donec auctor elit ut risus+mattis facilisis. Lorem ipsum dolor sit amet, consectetur adipiscing elit.++Proin vulputate sapien facilisis leo ornare pulvinar. Fusce tempus massa a risus+semper iaculis. Suspendisse sollicitudin posuere nunc, sit amet rutrum leo+facilisis mattis. Sed ornare auctor dui, vitae rutrum neque auctor sit amet.+Proin ac dui magna. Mauris vehicula interdum augue, nec ultrices libero egestas+quis. Nunc convallis euismod ipsum, id sollicitudin orci consequat ac. Fusce+bibendum congue libero, in rutrum nulla congue non. Cras sit amet risus tortor,+eu pellentesque dui. Phasellus euismod enim non nibh sodales quis consectetur+lorem laoreet. Vivamus a egestas quam. Curabitur in tortor augue, vitae varius+tellus. Integer varius, elit ac gravida suscipit, eros erat pellentesque nisi,+et tristique augue odio id nulla. Aliquam sit amet nunc vel tellus hendrerit+tempus ac vel sem.++Aenean tincidunt sollicitudin sapien ut porttitor. Curabitur molestie adipiscing+lorem vel scelerisque. Donec vitae interdum est. Proin rutrum vulputate+faucibus. Suspendisse sit amet felis odio, non volutpat ante. Sed eu lectus+quam. Curabitur tristique rhoncus est, vel commodo tortor suscipit semper.+Maecenas feugiat vestibulum nisi id facilisis. Nulla non tincidunt libero.+Praesent ultrices interdum commodo. Sed euismod nisl auctor leo ultrices rutrum.+Aliquam nibh felis, congue molestie blandit at, bibendum at eros. Aenean+tincidunt, tortor iaculis placerat sollicitudin, lorem justo tempor diam, et+posuere sapien leo et magna. Quisque vel aliquam mauris.++Proin varius tempus fermentum. Cum sociis natoque penatibus et magnis dis+parturient montes, nascetur ridiculus mus. Sed tincidunt nunc id magna+adipiscing non sollicitudin turpis tempor. Etiam vel elit ipsum, quis euismod+velit. Quisque elementum magna vitae quam venenatis lacinia. Sed at arcu ipsum.+Class aptent taciti sociosqu ad litora torquent per conubia nostra, per inceptos+himenaeos. Donec ut lorem ac sapien cursus lacinia sit amet mollis dolor.+Vivamus tempus odio nec magna faucibus sed hendrerit lorem tempor.++Vestibulum eu nisi arcu. Curabitur nisi risus, fermentum ut lacinia ut, interdum+nec magna. Nunc aliquet gravida massa, eu aliquam lorem faucibus at. Sed+sollicitudin volutpat velit id tempor. In nibh justo, pharetra et pretium+dignissim, tempus in turpis. Phasellus eget lobortis nisl. Phasellus sed+fermentum diam. Nam tempus pharetra odio, quis congue eros imperdiet eu. Aliquam+dui eros, hendrerit et vulputate vel, porta eu eros. Nullam nisi dui, commodo+eget pharetra ut, ornare sit amet nunc. Fusce vel neque urna. Maecenas nulla+ante, egestas at consequat quis, fermentum a enim. Aliquam id tristique urna.+Integer augue justo, scelerisque et consectetur id, rhoncus eget enim.
+ data/example/posts/2012-12-07-tu-quoque.markdown view
@@ -0,0 +1,57 @@+---+title: Tu Quoque+---++Vestibulum leo turpis, dignissim quis ultrices sit amet, iaculis ac ligula.+Pellentesque tristique, velit eget scelerisque scelerisque, est dolor ultrices+arcu, quis ullamcorper justo arcu luctus mauris. Integer congue molestie nisi id+posuere. Fusce pellentesque gravida tempus. Integer viverra tortor nec eros+mollis quis convallis sem laoreet. Nulla id libero ac erat varius laoreet. Proin+sed est est. Curabitur lacinia fermentum lorem, elementum malesuada ipsum+malesuada ut. Donec suscipit elit id leo vehicula mattis non sed leo. Morbi+varius eleifend varius. Nulla vestibulum, neque vitae aliquam eleifend, nisi+tellus placerat nunc, quis suscipit elit turpis eu tortor. Etiam euismod+convallis lectus quis venenatis. Phasellus laoreet magna in nibh cursus eu+egestas nulla convallis. Aliquam vel ullamcorper risus. Fusce dictum, massa id+consequat viverra, nulla ante tristique est, a faucibus nisi enim nec dui. Donec+metus ligula, condimentum at porttitor eget, lobortis at quam.++Aenean vel libero in magna ultricies congue in a odio. Donec faucibus rutrum+ornare. Fusce dictum eleifend fermentum. Vestibulum vel nibh a metus porttitor+rhoncus. Pellentesque id quam neque, eget molestie arcu. Integer in elit vel+neque viverra ultricies in eget massa. Nam ut convallis est. Pellentesque eros+eros, sodales non vehicula et, tincidunt ut odio. Cras suscipit ultrices metus+sit amet molestie. Fusce enim leo, vehicula sed sodales quis, adipiscing at+ipsum.++Nunc tempor dignissim enim, sed tincidunt eros bibendum quis. Curabitur et dolor+augue, id laoreet mi. Nulla cursus felis id dui vehicula vitae ornare lorem+blandit. Cras eget dui nec odio volutpat pharetra. Fusce hendrerit justo justo,+vel imperdiet enim. Vivamus elit risus, interdum ultrices accumsan eleifend,+vestibulum vitae sapien. Integer bibendum ullamcorper tristique. Nulla quis odio+lectus, quis eleifend augue. Integer a ligula mauris. Aenean et tempus tortor.+Quisque at tortor mi. Vivamus accumsan feugiat est a blandit. Sed vitae enim ut+dolor semper sodales. Duis tristique, ante et placerat elementum, nulla tellus+pellentesque sapien, quis posuere velit mi eget nulla. Sed vestibulum nunc non+est porttitor ut rutrum nibh semper. Pellentesque habitant morbi tristique+senectus et netus et malesuada fames ac turpis egestas.++Nulla adipiscing ultricies lobortis. Vivamus iaculis nisl vitae tellus laoreet+vitae aliquet lacus mollis. Phasellus ut lacus urna, sed sagittis ante. Etiam+consectetur pretium nisl sed dignissim. Pellentesque convallis, nisl eget+commodo mollis, sem magna consequat arcu, sed pretium ipsum arcu sit amet neque.+Aliquam erat volutpat. Morbi sed mi sed urna vestibulum placerat vitae vel+metus. Fusce ac ante at justo pharetra vehicula. Vivamus vel tortor eget augue+aliquet aliquet at vel odio. Nunc venenatis, magna quis facilisis fringilla,+augue tellus varius neque, in vulputate est eros ut tortor. Duis lorem neque,+aliquam congue posuere id, condimentum non dui. Phasellus ut dui massa,+porttitor suscipit augue. Praesent quis tellus quam, vel volutpat metus. Vivamus+enim est, aliquam in imperdiet et, sagittis eu ligula. Vestibulum hendrerit+placerat orci et aliquet. Cras pharetra, dolor placerat lobortis tempor, metus+odio cursus ligula, et posuere lacus ligula quis dui.++Donec a lectus eu nibh malesuada aliquam. Proin at metus quam, et tincidunt leo.+Quisque lacus justo, scelerisque sodales pulvinar sed, dignissim ut sapien.+Vivamus diam felis, adipiscing sollicitudin ultricies id, accumsan ac felis. In+eu posuere ligula. Suspendisse potenti. Donec porttitor dictum dui id vehicula.+Integer ante velit, congue id dictum et, adipiscing a tortor.
+ data/example/site.hs view
@@ -0,0 +1,72 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+import Control.Applicative ((<$>))+import Data.Monoid (mappend)+import Hakyll+++--------------------------------------------------------------------------------+main :: IO ()+main = hakyll $ do+ match "images/*" $ do+ route idRoute+ compile copyFileCompiler++ match "css/*" $ do+ route idRoute+ compile compressCssCompiler++ match (fromList ["about.rst", "contact.markdown"]) $ do+ route $ setExtension "html"+ compile $ pandocCompiler+ >>= loadAndApplyTemplate "templates/default.html" defaultContext+ >>= relativizeUrls++ match "posts/*" $ do+ route $ setExtension "html"+ compile $ pandocCompiler+ >>= loadAndApplyTemplate "templates/post.html" postCtx+ >>= loadAndApplyTemplate "templates/default.html" postCtx+ >>= relativizeUrls++ create ["archive.html"] $ do+ route idRoute+ compile $ do+ let archiveCtx =+ field "posts" (\_ -> postList recentFirst) `mappend`+ constField "title" "Archives" `mappend`+ defaultContext++ makeItem ""+ >>= loadAndApplyTemplate "templates/archive.html" archiveCtx+ >>= loadAndApplyTemplate "templates/default.html" archiveCtx+ >>= relativizeUrls+++ match "index.html" $ do+ route idRoute+ compile $ do+ let indexCtx = field "posts" $ \_ -> postList (take 3 . recentFirst)++ getResourceBody+ >>= applyAsTemplate indexCtx+ >>= loadAndApplyTemplate "templates/default.html" postCtx+ >>= relativizeUrls++ match "templates/*" $ compile templateCompiler+++--------------------------------------------------------------------------------+postCtx :: Context String+postCtx =+ dateField "date" "%B %e, %Y" `mappend`+ defaultContext+++--------------------------------------------------------------------------------+postList :: ([Item String] -> [Item String]) -> Compiler String+postList sortFilter = do+ posts <- sortFilter <$> loadAll "posts/*"+ itemTpl <- loadBody "templates/post-item.html"+ list <- applyTemplateList itemTpl postCtx posts+ return list
+ data/example/templates/archive.html view
@@ -0,0 +1,3 @@+<ul>+ $posts$+</ul>
+ data/example/templates/default.html view
@@ -0,0 +1,33 @@+<?xml version="1.0" encoding="UTF-8"?>+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">+ <head>+ <meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />+ <title>My Hakyll Blog - $title$</title>+ <link rel="stylesheet" type="text/css" href="/css/default.css" />+ </head>+ <body>+ <div id="header">+ <div id="logo">+ <a href="/">My Hakyll Blog</a>+ </div>+ <div id="navigation">+ <a href="/">Home</a>+ <a href="/about.html">About</a>+ <a href="/contact.html">Contact</a>+ <a href="/archive.html">Archive</a>+ </div>+ </div>++ <div id="content">+ <h1>$title$</h1>++ $body$+ </div>+ <div id="footer">+ Site proudly generated by+ <a href="http://jaspervdj.be/hakyll">Hakyll</a>+ </div>+ </body>+</html>
+ data/example/templates/post-item.html view
@@ -0,0 +1,3 @@+<li>+ <a href="$url$">$title$</a> - $date$+</li>
+ data/example/templates/post.html view
@@ -0,0 +1,3 @@+<div class="info">Posted on $date$</div>++$body$
hakyll.cabal view
@@ -1,5 +1,5 @@ Name: hakyll-Version: 3.5.3.0+Version: 4.0.0.0 Synopsis: A static website compiler library Description:@@ -40,12 +40,33 @@ Cabal-Version: >= 1.8 Build-Type: Simple Data-Dir: data-Data-Files:- templates/atom.xml++Data-files:+ example/posts/2012-11-28-carpe-diem.markdown+ example/posts/2012-10-07-rosa-rosa-rosam.markdown+ example/posts/2012-12-07-tu-quoque.markdown+ example/posts/2012-08-12-spqr.markdown+ example/site.hs+ example/images/haskell-logo.png+ example/templates/post-item.html+ example/templates/default.html+ example/templates/archive.html+ example/templates/post.html+ example/css/default.css+ example/index.html+ example/about.rst+ example/contact.markdown templates/atom-item.xml- templates/rss.xml+ templates/atom.xml templates/rss-item.xml+ templates/rss.xml +Extra-source-files:+ tests/data/example.md+ tests/data/example.md.metadata+ tests/data/template.html+ tests/data/template.html.out+ Source-Repository head Type: git Location: git://github.com/jaspervdj/hakyll.git@@ -68,16 +89,20 @@ citeproc-hs >= 0.3.2 && < 0.4, containers >= 0.3 && < 0.6, cryptohash >= 0.7 && < 0.9,+ deepseq >= 1.3 && < 1.4, directory >= 1.0 && < 1.3, filepath >= 1.0 && < 1.4,- hamlet >= 1.0 && < 1.2,+ http-conduit >= 1.8 && < 1.9,+ http-types >= 0.7 && < 0.8, lrucache >= 1.1.1 && < 1.2, mtl >= 1 && < 2.2, old-locale >= 1.0 && < 1.1, old-time >= 1.0 && < 1.2,+ cmdargs >= 0.10 && < 0.11, pandoc >= 1.9.3 && < 1.10, parsec >= 3.0 && < 3.2, process >= 1.0 && < 1.2,+ random >= 1.0 && < 1.1, regex-base >= 0.93 && < 0.94, regex-tdfa >= 1.1 && < 1.2, tagsoup >= 0.12.6 && < 0.13,@@ -86,56 +111,50 @@ Exposed-Modules: Hakyll- Hakyll.Core.CompiledItem Hakyll.Core.Compiler Hakyll.Core.Configuration- Hakyll.Core.DependencyAnalyzer- Hakyll.Core.DirectedGraph- Hakyll.Core.DirectedGraph.Dot+ Hakyll.Core.Dependencies+ Hakyll.Core.File Hakyll.Core.Identifier Hakyll.Core.Identifier.Pattern- Hakyll.Core.Logger- Hakyll.Core.Resource- Hakyll.Core.Resource.Provider- Hakyll.Core.Resource.Provider.Dummy- Hakyll.Core.Resource.Provider.File+ Hakyll.Core.Item+ Hakyll.Core.Metadata Hakyll.Core.Routes Hakyll.Core.Rules- Hakyll.Core.Run- Hakyll.Core.Store Hakyll.Core.UnixFilter- Hakyll.Core.Util.Arrow- Hakyll.Core.Util.File Hakyll.Core.Util.String Hakyll.Core.Writable- Hakyll.Core.Writable.CopyFile- Hakyll.Core.Writable.WritableTuple Hakyll.Main- Hakyll.Web.Blaze Hakyll.Web.CompressCss Hakyll.Web.Feed- Hakyll.Web.Page- Hakyll.Web.Page.List- Hakyll.Web.Page.Metadata- Hakyll.Web.Page.Read+ Hakyll.Web.Html+ Hakyll.Web.Html.RelativizeUrls Hakyll.Web.Pandoc Hakyll.Web.Pandoc.Biblio Hakyll.Web.Pandoc.FileType Hakyll.Web.Tags Hakyll.Web.Template+ Hakyll.Web.Template.Context+ Hakyll.Web.Template.List Hakyll.Web.Template.Read- Hakyll.Web.Urls- Hakyll.Web.Urls.Relativize- Hakyll.Web.Util.Html Other-Modules:+ Hakyll.Check+ Hakyll.Commands Hakyll.Core.Compiler.Internal- Hakyll.Core.DirectedGraph.Internal+ Hakyll.Core.Compiler.Require+ Hakyll.Core.Item.SomeItem+ Hakyll.Core.Logger+ Hakyll.Core.Provider+ Hakyll.Core.Provider.Internal+ Hakyll.Core.Provider.Metadata+ Hakyll.Core.Provider.MetadataCache+ Hakyll.Core.Provider.Modified Hakyll.Core.Rules.Internal- Hakyll.Web.Page.Internal+ Hakyll.Core.Runtime+ Hakyll.Core.Store+ Hakyll.Core.Util.File Hakyll.Web.Template.Internal- Hakyll.Web.Template.Read.Hakyll- Hakyll.Web.Template.Read.Hamlet Paths_hakyll If flag(previewServer)@@ -145,8 +164,8 @@ Cpp-options: -DPREVIEW_SERVER Other-modules:- Hakyll.Web.Preview.Poll- Hakyll.Web.Preview.Server+ Hakyll.Preview.Poll+ Hakyll.Preview.Server Test-suite hakyll-tests Type: exitcode-stdio-1.0@@ -169,37 +188,48 @@ citeproc-hs >= 0.3.2 && < 0.4, containers >= 0.3 && < 0.6, cryptohash >= 0.7 && < 0.9,+ deepseq >= 1.3 && < 1.4, directory >= 1.0 && < 1.3, filepath >= 1.0 && < 1.4,- hamlet >= 1.0 && < 1.2,+ http-conduit >= 1.8 && < 1.9,+ http-types >= 0.7 && < 0.8, lrucache >= 1.1.1 && < 1.2, mtl >= 1 && < 2.2, old-locale >= 1.0 && < 1.1, old-time >= 1.0 && < 1.2,+ cmdargs >= 0.10 && < 0.11, pandoc >= 1.9.3 && < 1.10, parsec >= 3.0 && < 3.2, process >= 1.0 && < 1.2,+ random >= 1.0 && < 1.1, regex-base >= 0.93 && < 0.94, regex-tdfa >= 1.1 && < 1.2, tagsoup >= 0.12.6 && < 0.13, text >= 0.11 && < 1.12,- time >= 1.1 && < 1.5,- unix >= 2.4 && < 2.7+ time >= 1.1 && < 1.5 Other-modules:- Hakyll.Web.Util.Html.Tests- Hakyll.Web.Urls.Relativize.Tests- Hakyll.Web.Urls.Tests- Hakyll.Web.Template.Tests- Hakyll.Web.Page.Metadata.Tests- Hakyll.Web.Page.Tests- Hakyll.Core.Compiler.Tests+ Hakyll.Core.Dependencies.Tests Hakyll.Core.Identifier.Tests- Hakyll.Core.Util.Arrow.Tests- Hakyll.Core.Util.String.Tests- Hakyll.Core.UnixFilter.Tests+ Hakyll.Core.Provider.Tests Hakyll.Core.Routes.Tests- Hakyll.Core.Store.Tests Hakyll.Core.Rules.Tests- Hakyll.Core.DependencyAnalyzer.Tests+ Hakyll.Core.Runtime.Tests+ Hakyll.Core.Store.Tests+ Hakyll.Core.UnixFilter.Tests+ Hakyll.Core.Util.String.Tests+ Hakyll.Web.Template.Context.Tests+ Hakyll.Web.Template.Tests+ Hakyll.Web.Html.Tests+ Hakyll.Web.Html.RelativizeUrls.Tests TestSuite.Util++Executable hakyll-init+ Ghc-options: -Wall+ Hs-source-dirs: src+ Main-is: Hakyll/Init.hs++ Build-depends:+ base >= 4 && < 5,+ directory >= 1.0 && < 1.3,+ filepath >= 1.0 && < 1.4
src/Hakyll.hs view
@@ -1,70 +1,60 @@+-------------------------------------------------------------------------------- -- | Top-level module exporting all modules that are interesting for the user--- {-# LANGUAGE CPP #-} module Hakyll ( module Hakyll.Core.Compiler , module Hakyll.Core.Configuration+ , module Hakyll.Core.File , module Hakyll.Core.Identifier , module Hakyll.Core.Identifier.Pattern- , module Hakyll.Core.Resource- , module Hakyll.Core.Resource.Provider+ , module Hakyll.Core.Item+ , module Hakyll.Core.Metadata , module Hakyll.Core.Routes , module Hakyll.Core.Rules , module Hakyll.Core.UnixFilter- , module Hakyll.Core.Util.Arrow , module Hakyll.Core.Util.File , module Hakyll.Core.Util.String , module Hakyll.Core.Writable- , module Hakyll.Core.Writable.CopyFile- , module Hakyll.Core.Writable.WritableTuple , module Hakyll.Main- , module Hakyll.Web.Blaze , module Hakyll.Web.CompressCss , module Hakyll.Web.Feed- , module Hakyll.Web.Page- , module Hakyll.Web.Page.List- , module Hakyll.Web.Page.Metadata- , module Hakyll.Web.Page.Read+ , module Hakyll.Web.Html+ , module Hakyll.Web.Html.RelativizeUrls , module Hakyll.Web.Pandoc , module Hakyll.Web.Pandoc.Biblio , module Hakyll.Web.Pandoc.FileType- , module Hakyll.Web.Urls- , module Hakyll.Web.Urls.Relativize , module Hakyll.Web.Tags , module Hakyll.Web.Template+ , module Hakyll.Web.Template.Context+ , module Hakyll.Web.Template.List , module Hakyll.Web.Template.Read- , module Hakyll.Web.Util.Html ) where -import Hakyll.Core.Compiler-import Hakyll.Core.Configuration-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Routes-import Hakyll.Core.Rules-import Hakyll.Core.UnixFilter-import Hakyll.Core.Util.Arrow-import Hakyll.Core.Util.File-import Hakyll.Core.Util.String-import Hakyll.Core.Writable-import Hakyll.Core.Writable.CopyFile-import Hakyll.Core.Writable.WritableTuple-import Hakyll.Main-import Hakyll.Web.Blaze-import Hakyll.Web.CompressCss-import Hakyll.Web.Feed-import Hakyll.Web.Page-import Hakyll.Web.Page.List-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Page.Read-import Hakyll.Web.Pandoc-import Hakyll.Web.Pandoc.Biblio-import Hakyll.Web.Pandoc.FileType-import Hakyll.Web.Urls-import Hakyll.Web.Urls.Relativize-import Hakyll.Web.Tags-import Hakyll.Web.Template-import Hakyll.Web.Template.Read-import Hakyll.Web.Util.Html++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Configuration+import Hakyll.Core.File+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Item+import Hakyll.Core.Metadata+import Hakyll.Core.Routes+import Hakyll.Core.Rules+import Hakyll.Core.UnixFilter+import Hakyll.Core.Util.File+import Hakyll.Core.Util.String+import Hakyll.Core.Writable+import Hakyll.Main+import Hakyll.Web.CompressCss+import Hakyll.Web.Feed+import Hakyll.Web.Html+import Hakyll.Web.Html.RelativizeUrls+import Hakyll.Web.Pandoc+import Hakyll.Web.Pandoc.Biblio+import Hakyll.Web.Pandoc.FileType+import Hakyll.Web.Tags+import Hakyll.Web.Template+import Hakyll.Web.Template.Context+import Hakyll.Web.Template.List+import Hakyll.Web.Template.Read
+ src/Hakyll/Check.hs view
@@ -0,0 +1,199 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Check+ ( Check (..)+ , check+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Exception (AsyncException (..),+ SomeException (..), handle, throw)+import Control.Monad (forM_)+import Control.Monad.Reader (ask)+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.Monoid (Monoid (..))+import Data.Set (Set)+import qualified Data.Set as S+import Data.Typeable (cast)+import qualified Network.HTTP.Conduit as Http+import qualified Network.HTTP.Types as Http+import System.Directory (doesDirectoryExist, doesFileExist)+import System.Exit (ExitCode (..))+import System.FilePath (takeDirectory, takeExtension, (</>))+import qualified Text.HTML.TagSoup as TS+++--------------------------------------------------------------------------------+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+++--------------------------------------------------------------------------------+data Check = All | InternalLinks+ deriving (Eq, Ord, Show)+++--------------------------------------------------------------------------------+check :: Configuration -> Verbosity -> Check -> IO ExitCode+check config verbosity check' = do+ ((), write) <- runChecker checkDestination config verbosity check'+ return $ if checkerFaulty write >= 0 then ExitFailure 1 else ExitSuccess+++--------------------------------------------------------------------------------+data CheckerRead = CheckerRead+ { checkerConfig :: Configuration+ , checkerLogger :: Logger+ , checkerCheck :: Check+ }+++--------------------------------------------------------------------------------+data CheckerWrite = CheckerWrite+ { checkerFaulty :: Int+ , checkerOk :: Int+ } deriving (Show)+++--------------------------------------------------------------------------------+instance Monoid CheckerWrite where+ mempty = CheckerWrite 0 0+ mappend (CheckerWrite f1 o1) (CheckerWrite f2 o2) =+ CheckerWrite (f1 + f2) (o1 + o2)+++--------------------------------------------------------------------------------+type CheckerState = Set String+++--------------------------------------------------------------------------------+type Checker a = RWST CheckerRead CheckerWrite CheckerState IO a+++--------------------------------------------------------------------------------+runChecker :: Checker a -> Configuration -> Verbosity -> Check+ -> IO (a, CheckerWrite)+runChecker checker config verbosity check' = do+ logger <- Logger.new verbosity+ let read' = CheckerRead config logger check'+ (x, _, write) <- runRWST checker read' S.empty+ Logger.flush logger+ return (x, write)+++--------------------------------------------------------------------------------+checkDestination :: Checker ()+checkDestination = do+ config <- checkerConfig <$> ask+ files <- liftIO $ getRecursiveContents (destinationDirectory config)++ let htmls =+ [ destinationDirectory config </> file+ | file <- files+ , takeExtension file == ".html"+ ]++ forM_ htmls checkFile+++--------------------------------------------------------------------------------+checkFile :: FilePath -> Checker ()+checkFile filePath = do+ logger <- checkerLogger <$> ask+ contents <- liftIO $ readFile filePath+ Logger.header logger $ "Checking file " ++ filePath++ let urls = getUrls $ TS.parseTags contents+ forM_ urls $ \url -> do+ Logger.debug logger $ "Checking link " ++ url+ if isExternal url+ then checkExternalUrl url+ else checkInternalUrl filePath url+++--------------------------------------------------------------------------------+ok :: String -> Checker ()+ok _ = tell $ mempty {checkerOk = 1}+++--------------------------------------------------------------------------------+faulty :: String -> Checker ()+faulty url = do+ logger <- checkerLogger <$> ask+ Logger.error logger $ "Broken link to " ++ show url+ tell $ mempty {checkerFaulty = 1}+++--------------------------------------------------------------------------------+checkInternalUrl :: FilePath -> String -> Checker ()+checkInternalUrl base url = case url' of+ "" -> ok url+ _ -> do+ config <- checkerConfig <$> ask+ let dest = destinationDirectory config+ dir = takeDirectory base+ filePath+ | "/" `isPrefixOf` url' = dest ++ url'+ | otherwise = dir </> url'++ exists <- checkFileExists filePath+ if exists then ok url else faulty url+ where+ url' = stripFragments url+++--------------------------------------------------------------------------------+checkExternalUrl :: String -> Checker ()+checkExternalUrl url = do+ logger <- checkerLogger <$> ask+ needsCheck <- (== All) . checkerCheck <$> ask+ checked <- (url `S.member`) <$> get++ if not needsCheck || checked+ then Logger.debug logger "Already checked, skipping"+ else do+ isOk <- liftIO $ handle (failure logger) $+ Http.withManager $ \mgr -> do+ request <- Http.parseUrl url+ response <- Http.http (settings request) mgr+ let code = Http.statusCode (Http.responseStatus response)+ return $ code >= 200 && code < 300++ modify $ S.insert url+ if isOk then ok url else faulty url+ where+ settings r = r+ { Http.method = "HEAD"+ , Http.redirectCount = 10+ }++ -- Catch all the things except UserInterrupt+ failure logger (SomeException e) = case cast e of+ Just UserInterrupt -> throw UserInterrupt+ _ -> Logger.error logger (show e) >> return False+++--------------------------------------------------------------------------------+-- | Wraps doesFileExist, also checks for index.html+checkFileExists :: FilePath -> Checker Bool+checkFileExists filePath = liftIO $ do+ file <- doesFileExist filePath+ dir <- doesDirectoryExist filePath+ case (file, dir) of+ (True, _) -> return True+ (_, True) -> doesFileExist $ filePath </> "index.html"+ _ -> return False+++--------------------------------------------------------------------------------+stripFragments :: String -> String+stripFragments = takeWhile (not . flip elem ['?', '#'])
+ src/Hakyll/Commands.hs view
@@ -0,0 +1,129 @@+--------------------------------------------------------------------------------+-- | Implementation of Hakyll commands: build, preview...+{-# LANGUAGE CPP #-}+module Hakyll.Commands+ ( build+ , check+ , clean+ , preview+ , rebuild+ , server+ , deploy+ ) where+++--------------------------------------------------------------------------------+import System.Exit (ExitCode (ExitSuccess), exitWith)+import System.Process (system)+++--------------------------------------------------------------------------------+import qualified Hakyll.Check as Check+import Hakyll.Core.Configuration+import Hakyll.Core.Logger (Verbosity)+import Hakyll.Core.Rules+import Hakyll.Core.Runtime+import Hakyll.Core.Util.File+++--------------------------------------------------------------------------------+#ifdef PREVIEW_SERVER+import Control.Concurrent (forkIO)+import qualified Data.Set as S+import Hakyll.Core.Identifier+import Hakyll.Core.Rules.Internal+import Hakyll.Preview.Poll+import Hakyll.Preview.Server+#endif+++--------------------------------------------------------------------------------+-- | Build the site+build :: Configuration -> Verbosity -> Rules a -> IO ()+build conf verbosity rules = do+ _ <- run conf verbosity rules+ return ()+++--------------------------------------------------------------------------------+-- | Run the checker and exit+check :: Configuration -> Verbosity -> Check.Check -> IO ()+check config verbosity check' = Check.check config verbosity check' >>= exitWith+++--------------------------------------------------------------------------------+-- | Remove the output directories+clean :: Configuration -> IO ()+clean conf = do+ remove $ destinationDirectory conf+ remove $ storeDirectory conf+ remove $ tmpDirectory conf+ where+ remove dir = do+ putStrLn $ "Removing " ++ dir ++ "..."+ removeDirectory dir+++--------------------------------------------------------------------------------+-- | Preview the site+preview :: Configuration -> Verbosity -> Rules a -> Int -> IO ()+#ifdef PREVIEW_SERVER+preview conf verbosity rules port = do+ -- Run the server in a separate thread+ _ <- forkIO $ server conf port+ previewPoll conf update+ where+ update = do+ (exitCode, ruleSet) <- run conf verbosity rules+ case exitCode of+ ExitSuccess -> return $ map toFilePath $ S.toList $+ rulesResources ruleSet+ _ -> exitWith exitCode+#else+preview _ _ _ _ = previewServerDisabled+#endif+++--------------------------------------------------------------------------------+-- | Rebuild the site+rebuild :: Configuration -> Verbosity -> Rules a -> IO ()+rebuild conf verbosity rules = do+ clean conf+ build conf verbosity rules+++--------------------------------------------------------------------------------+-- | Start a server+server :: Configuration -> Int -> IO ()+#ifdef PREVIEW_SERVER+server conf port = do+ let destination = destinationDirectory conf+ staticServer destination preServeHook port+ where+ preServeHook _ = return ()+#else+server _ _ = previewServerDisabled+#endif+++--------------------------------------------------------------------------------+-- | Upload the site+deploy :: Configuration -> IO ()+deploy conf = do+ _ <- system $ deployCommand conf+ return ()+++--------------------------------------------------------------------------------+-- | Print a warning message about the preview serving not being enabled+#ifndef PREVIEW_SERVER+previewServerDisabled :: IO ()+previewServerDisabled =+ mapM_ putStrLn+ [ "PREVIEW SERVER"+ , ""+ , "The preview server is not enabled in the version of Hakyll. To"+ , "enable it, set the flag to True and recompile Hakyll."+ , "Alternatively, use an external tool to serve your site directory."+ ]+#endif
− src/Hakyll/Core/CompiledItem.hs
@@ -1,47 +0,0 @@--- | A module containing a box datatype representing a compiled item. This--- item can be of any type, given that a few restrictions hold:------ * we need a 'Typeable' instance to perform type-safe casts;------ * we need a 'Binary' instance so we can serialize these items to the cache;------ * we need a 'Writable' instance so the results can be saved.----{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-}-module Hakyll.Core.CompiledItem- ( CompiledItem (..)- , compiledItem- , unCompiledItem- ) where--import Data.Binary (Binary)-import Data.Typeable (Typeable, cast, typeOf)-import Data.Maybe (fromMaybe)--import Hakyll.Core.Writable---- | Box type for a compiled item----data CompiledItem = forall a. (Binary a, Typeable a, Writable a)- => CompiledItem a- deriving (Typeable)--instance Writable CompiledItem where- write p (CompiledItem x) = write p x---- | Box a value into a 'CompiledItem'----compiledItem :: (Binary a, Typeable a, Writable a)- => a- -> CompiledItem-compiledItem = CompiledItem---- | Unbox a value from a 'CompiledItem'----unCompiledItem :: (Binary a, Typeable a, Writable a)- => CompiledItem- -> a-unCompiledItem (CompiledItem x) = fromMaybe error' $ cast x- where- error' = error $ "Hakyll.Core.CompiledItem.unCompiledItem: "- ++ "unsupported type (got " ++ show (typeOf x) ++ ")"
src/Hakyll/Core/Compiler.hs view
@@ -1,399 +1,162 @@--- | A Compiler manages targets and dependencies between targets------ The most distinguishing property of a 'Compiler' is that it is an Arrow. A--- compiler of the type @Compiler a b@ is simply a compilation phase which takes--- an @a@ as input, and produces a @b@ as output.------ Compilers are chained using the '>>>' arrow operation. If we have a compiler------ > getResourceString :: Compiler Resource String------ which reads the resource, and a compiler------ > readPage :: Compiler String (Page String)------ we can chain these two compilers to get a------ > (getResourceString >>> readPage) :: Compiler Resource (Page String)------ Most compilers can be created by combining smaller compilers using '>>>'.------ More advanced constructions are also possible using arrow, and sometimes--- these are needed. For a good introduction to arrow, you can refer to------ <http://en.wikibooks.org/wiki/Haskell/Understanding_arrows>------ A construction worth writing a few paragraphs about here are the 'require'--- functions. Different variants of this function are exported here, but they--- all serve more or less the same goal.------ When you use only '>>>' to chain your compilers, you get a linear pipeline ----- it is not possible to add extra items from other compilers along the way.--- This is where the 'require' functions come in.------ This function allows you to reference other items, which are then added to--- the pipeline. Let's look at this crappy ASCII illustration which represents--- a pretty common scenario:------ > read resource >>> pandoc render >>> layout >>> relativize URL's--- >--- > @templates/fancy.html@------ We want to construct a pipeline of compilers to go from our resource to a--- proper webpage. However, the @layout@ compiler takes more than just the--- rendered page as input: it needs the @templates/fancy.html@ template as well.------ This is an example of where we need the @require@ function. We can solve--- this using a construction that looks like:------ > ... >>> pandoc render >>> require >>> layout >>> ...--- > |--- > @templates/fancy.html@ ------/------ This illustration can help us understand the type signature of 'require'.------ > require :: (Binary a, Typeable a, Writable a)--- > => Identifier a--- > -> (b -> a -> c)--- > -> Compiler b c------ Let's look at it in detail:------ > (Binary a, Typeable a, Writable a)------ These are constraints for the @a@ type. @a@ (the template) needs to have--- certain properties for it to be required.------ > Identifier a------ This is simply @templates/fancy.html@: the 'Identifier' of the item we want--- to 'require', in other words, the name of the item we want to add to the--- pipeline somehow.------ > (b -> a -> c)------ This is a function given by the user, specifying /how/ the two items shall be--- merged. @b@ is the output of the previous compiler, and @a@ is the item we--- just required -- the template. This means @c@ will be the final output of the--- 'require' combinator.------ > Compiler b c------ Indeed, we have now constructed a compiler which takes a @b@ and produces a--- @c@. This means that we have a linear pipeline again, thanks to the 'require'--- function. So, the 'require' function actually helps to reduce to complexity--- of Hakyll applications!------ Note that require will fetch a previously compiled item: in our example of--- the type @a@. It is /very/ important that the compiler which produced this--- value, produced the right type as well!----{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables #-}+--------------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-} module Hakyll.Core.Compiler ( Compiler- , runCompiler- , getIdentifier- , getResource+ , getUnderlying+ , getUnderlyingExtension+ , makeItem , getRoute- , getRouteFor+ , getResourceBody , getResourceString , getResourceLBS , getResourceWith- , fromDependency- , require_- , require- , requireA- , requireAll_- , requireAll- , requireAllA++ , Internal.Snapshot+ , saveSnapshot+ , Internal.load+ , Internal.loadSnapshot+ , Internal.loadBody+ , Internal.loadSnapshotBody+ , Internal.loadAll+ , Internal.loadAllSnapshots+ , cached , unsafeCompiler- , traceShowCompiler- , mapCompiler- , timedCompiler- , byPattern- , byExtension+ , debugCompiler ) where -import Prelude hiding ((.), id)-import Control.Arrow ((>>>), (&&&), arr, first)-import Control.Applicative ((<$>))-import Control.Exception (SomeException, handle)-import Control.Monad.Reader (ask)-import Control.Monad.Trans (liftIO)-import Control.Monad.Error (throwError)-import Control.Category (Category, (.), id)-import Data.List (find)-import System.Environment (getProgName)-import System.FilePath (takeExtension) -import Data.Binary (Binary)-import Data.Typeable (Typeable)-import Data.ByteString.Lazy (ByteString)+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Data.Binary (Binary)+import Data.ByteString.Lazy (ByteString)+import Data.Typeable (Typeable)+import System.Environment (getProgName)+import System.FilePath (takeExtension) -import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.CompiledItem-import Hakyll.Core.Writable-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Store (Store)-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Routes-import Hakyll.Core.Logger-import qualified Hakyll.Core.Store as Store --- | Run a compiler, yielding the resulting target and it's dependencies. This--- version of 'runCompilerJob' also stores the result----runCompiler :: Compiler () CompileRule -- ^ Compiler to run- -> Identifier () -- ^ Target identifier- -> ResourceProvider -- ^ Resource provider- -> [Identifier ()] -- ^ Universe- -> Routes -- ^ Route- -> Store -- ^ Store- -> Bool -- ^ Was the resource modified?- -> Logger -- ^ Logger- -> IO (Throwing CompileRule) -- ^ Resulting item-runCompiler compiler id' provider universe routes store modified logger = do- -- Run the compiler job- result <- handle (\(e :: SomeException) -> return $ Left $ show e) $- runCompilerJob compiler id' provider universe routes store modified- logger+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import qualified Hakyll.Core.Compiler.Require as Internal+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Core.Logger as Logger+import Hakyll.Core.Provider+import Hakyll.Core.Routes+import qualified Hakyll.Core.Store as Store - -- Inspect the result- case result of- -- In case we compiled an item, we will store a copy in the cache first,- -- before we return control. This makes sure the compiled item can later- -- be accessed by e.g. require.- Right (CompileRule (CompiledItem x)) ->- Store.set store ["Hakyll.Core.Compiler.runCompiler", show id'] x - -- Otherwise, we do nothing here- _ -> return ()+--------------------------------------------------------------------------------+-- | Get the underlying identifier.+getUnderlying :: Compiler Identifier+getUnderlying = compilerUnderlying <$> compilerAsk - return result --- | Get the identifier of the item that is currently being compiled----getIdentifier :: Compiler a (Identifier b)-getIdentifier = fromJob $ const $ CompilerM $- castIdentifier . compilerIdentifier <$> ask+--------------------------------------------------------------------------------+-- | Get the extension of the underlying identifier. Returns something like+-- @".html"@+getUnderlyingExtension :: Compiler String+getUnderlyingExtension = takeExtension . toFilePath <$> getUnderlying --- | Get the resource that is currently being compiled----getResource :: Compiler a Resource-getResource = getIdentifier >>> arr fromIdentifier --- | Get the route we are using for this item----getRoute :: Compiler a (Maybe FilePath)-getRoute = getIdentifier >>> getRouteFor+--------------------------------------------------------------------------------+makeItem :: a -> Compiler (Item a)+makeItem x = do+ identifier <- getUnderlying+ return $ Item identifier x ++-------------------------------------------------------------------------------- -- | Get the route for a specified item----getRouteFor :: Compiler (Identifier a) (Maybe FilePath)-getRouteFor = fromJob $ \identifier -> CompilerM $ do- routes <- compilerRoutes <$> ask+getRoute :: Identifier -> Compiler (Maybe FilePath)+getRoute identifier = do+ routes <- compilerRoutes <$> compilerAsk return $ runRoutes routes identifier ++--------------------------------------------------------------------------------+-- | Get the body of the underlying resource+getResourceBody :: Compiler (Item String)+getResourceBody = getResourceWith resourceBody+++-------------------------------------------------------------------------------- -- | Get the resource we are compiling as a string----getResourceString :: Compiler Resource String+getResourceString :: Compiler (Item String) getResourceString = getResourceWith resourceString ++-------------------------------------------------------------------------------- -- | Get the resource we are compiling as a lazy bytestring----getResourceLBS :: Compiler Resource ByteString+getResourceLBS :: Compiler (Item ByteString) getResourceLBS = getResourceWith resourceLBS ++-------------------------------------------------------------------------------- -- | Overloadable function for 'getResourceString' and 'getResourceLBS'----getResourceWith :: (ResourceProvider -> Resource -> IO a)- -> Compiler Resource a-getResourceWith reader = fromJob $ \r -> CompilerM $ do- let filePath = unResource r- provider <- compilerResourceProvider <$> ask- if resourceExists provider r- then liftIO $ reader provider r- else throwError $ error' filePath+getResourceWith :: (Provider -> Identifier -> IO a) -> Compiler (Item a)+getResourceWith reader = do+ provider <- compilerProvider <$> compilerAsk+ id' <- compilerUnderlying <$> compilerAsk+ let filePath = toFilePath id'+ if resourceExists provider id'+ then compilerUnsafeIO $ Item id' <$> reader provider id'+ else compilerThrow $ error' filePath where- error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "- ++ show id' ++ " not found"+ error' fp = "Hakyll.Core.Compiler.getResourceWith: resource " +++ show fp ++ " not found" --- | Auxiliary: get a dependency----getDependency :: (Binary a, Writable a, Typeable a)- => Identifier a -> CompilerM a-getDependency id' = CompilerM $ do- store <- compilerStore <$> ask- result <- liftIO $- Store.get store ["Hakyll.Core.Compiler.runCompiler", show id']- case result of- Store.NotFound -> throwError notFound- Store.WrongType e r -> throwError $ wrongType e r- Store.Found x -> return x- where- notFound =- "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was " ++- "not found in the cache, the cache might be corrupted or " ++- "the item you are referring to might not exist"- wrongType e r =- "Hakyll.Core.Compiler.getDependency: " ++ show id' ++ " was found " ++- "in the cache, but does not have the right type: expected " ++ show e ++- " but got " ++ show r --- | Variant of 'require' which drops the current value----require_ :: (Binary a, Typeable a, Writable a)- => Identifier a- -> Compiler b a-require_ identifier =- fromDependency identifier >>> fromJob (const $ getDependency identifier)+--------------------------------------------------------------------------------+-- | Save a snapshot of the item. This function returns the same item, which+-- convenient for building '>>=' chains.+saveSnapshot :: (Binary a, Typeable a)+ => Internal.Snapshot -> Item a -> Compiler (Item a)+saveSnapshot snapshot item = do+ store <- compilerStore <$> compilerAsk+ logger <- compilerLogger <$> compilerAsk+ compilerUnsafeIO $ do+ Logger.debug logger $ "Storing snapshot: " ++ snapshot+ Internal.saveSnapshot store snapshot item+ return item --- | Require another target. Using this function ensures automatic handling of--- dependencies----require :: (Binary a, Typeable a, Writable a)- => Identifier a- -> (b -> a -> c)- -> Compiler b c-require identifier = requireA identifier . arr . uncurry --- | Arrow-based variant of 'require'----requireA :: (Binary a, Typeable a, Writable a)- => Identifier a- -> Compiler (b, a) c- -> Compiler b c-requireA identifier = (id &&& require_ identifier >>>)---- | Variant of 'requireAll' which drops the current value----requireAll_ :: (Binary a, Typeable a, Writable a)- => Pattern a- -> Compiler b [a]-requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_'- where- getDeps = map castIdentifier . filterMatches pattern . map castIdentifier- requireAll_' = const $ CompilerM $ do- deps <- getDeps . compilerUniverse <$> ask- mapM (unCompilerM . getDependency) deps---- | Require a number of targets. Using this function ensures automatic handling--- of dependencies----requireAll :: (Binary a, Typeable a, Writable a)- => Pattern a- -> (b -> [a] -> c)- -> Compiler b c-requireAll pattern = requireAllA pattern . arr . uncurry---- | Arrow-based variant of 'requireAll'----requireAllA :: (Binary a, Typeable a, Writable a)- => Pattern a- -> Compiler (b, [a]) c- -> Compiler b c-requireAllA pattern = (id &&& requireAll_ pattern >>>)--cached :: (Binary a, Typeable a, Writable a)+--------------------------------------------------------------------------------+cached :: (Binary a, Typeable a) => String- -> Compiler Resource a- -> Compiler Resource a-cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do- logger <- compilerLogger <$> ask- identifier <- castIdentifier . compilerIdentifier <$> ask- store <- compilerStore <$> ask- modified <- compilerResourceModified <$> ask- progName <- liftIO getProgName- report logger $ "Checking cache: " ++ if modified then "modified" else "OK"+ -> Compiler a+ -> Compiler a+cached name compiler = do+ id' <- compilerUnderlying <$> compilerAsk+ store <- compilerStore <$> compilerAsk+ provider <- compilerProvider <$> compilerAsk+ modified <- compilerUnsafeIO $ resourceModified provider id' if modified- then do v <- unCompilerM $ j $ fromIdentifier identifier- liftIO $ Store.set store [name, show identifier] v- return v- else do v <- liftIO $ Store.get store [name, show identifier]- case v of Store.Found v' -> return v'- _ -> throwError (error' progName)+ then do+ x <- compiler+ compilerUnsafeIO $ Store.set store [name, show id'] x+ return x+ else do+ compilerTellCacheHits 1+ x <- compilerUnsafeIO $ Store.get store [name, show id']+ progName <- compilerUnsafeIO getProgName+ case x of Store.Found x' -> return x'+ _ -> compilerThrow (error' progName) where error' progName = "Hakyll.Core.Compiler.cached: Cache corrupt! " ++ "Try running: " ++ progName ++ " clean" --- | Create an unsafe compiler from a function in IO----unsafeCompiler :: (a -> IO b) -- ^ Function to lift- -> Compiler a b -- ^ Resulting compiler-unsafeCompiler f = fromJob $ CompilerM . liftIO . f --- | Compiler for debugging purposes----traceShowCompiler :: Show a => Compiler a a-traceShowCompiler = fromJob $ \x -> CompilerM $ do- logger <- compilerLogger <$> ask- report logger $ show x- return x+--------------------------------------------------------------------------------+unsafeCompiler :: IO a -> Compiler a+unsafeCompiler = compilerUnsafeIO --- | Map over a compiler----mapCompiler :: Compiler a b- -> Compiler [a] [b]-mapCompiler (Compiler d j) = Compiler d $ mapM j --- | Log and time a compiler----timedCompiler :: String -- ^ Message- -> Compiler a b -- ^ Compiler to time- -> Compiler a b -- ^ Resulting compiler-timedCompiler msg (Compiler d j) = Compiler d $ \x -> CompilerM $ do- logger <- compilerLogger <$> ask- timed logger msg $ unCompilerM $ j x---- | Choose a compiler by identifier------ For example, assume that most content files need to be compiled--- normally, but a select few need an extra step in the pipeline:------ > compile $ pageCompiler >>> byPattern id--- > [ ("projects.md", addProjectListCompiler)--- > , ("sitemap.md", addSiteMapCompiler)--- > ]----byPattern :: Compiler a b -- ^ Default compiler- -> [(Pattern (), Compiler a b)] -- ^ Choices- -> Compiler a b -- ^ Resulting compiler-byPattern defaultCompiler choices = Compiler deps job- where- -- Lookup the compiler, give an error when it is not found- lookup' identifier = maybe defaultCompiler snd $- find (\(p, _) -> matches p identifier) choices- -- Collect the dependencies of the choice- deps = do- identifier <- castIdentifier . dependencyIdentifier <$> ask- compilerDependencies $ lookup' identifier- -- Collect the job of the choice- job x = CompilerM $ do- identifier <- castIdentifier . compilerIdentifier <$> ask- unCompilerM $ compilerJob (lookup' identifier) x---- | Choose a compiler by extension------ Example:------ > match "css/*" $ do--- > route $ setExtension "css"--- > compile $ byExtension (error "Not a (S)CSS file")--- > [ (".css", compressCssCompiler)--- > , (".scss", sass)--- > ]------ This piece of code will select the @compressCssCompiler@ for @.css@ files,--- and the @sass@ compiler (defined elsewhere) for @.scss@ files.----byExtension :: Compiler a b -- ^ Default compiler- -> [(String, Compiler a b)] -- ^ Choices- -> Compiler a b -- ^ Resulting compiler-byExtension defaultCompiler = byPattern defaultCompiler . map (first extPattern)- where- extPattern c = predicate $ (== c) . takeExtension . toFilePath+--------------------------------------------------------------------------------+-- | Compiler for debugging purposes+debugCompiler :: String -> Compiler ()+debugCompiler msg = do+ logger <- compilerLogger <$> compilerAsk+ compilerUnsafeIO $ Logger.debug logger msg
src/Hakyll/Core/Compiler/Internal.hs view
@@ -1,156 +1,232 @@+-------------------------------------------------------------------------------- -- | Internally used compiler module---+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Compiler.Internal- ( Dependencies- , DependencyEnvironment (..)- , CompilerEnvironment (..)- , Throwing- , CompilerM (..)+ ( -- * Types+ CompilerRead (..)+ , CompilerWrite (..)+ , CompilerResult (..) , Compiler (..)- , runCompilerJob- , runCompilerDependencies- , fromJob- , fromDependencies- , fromDependency+ , runCompiler++ -- * Core operations+ , compilerTell+ , compilerAsk+ , compilerThrow+ , compilerCatch+ , compilerResult+ , compilerUnsafeIO++ -- * Utilities+ , compilerTellDependencies+ , compilerTellCacheHits ) where -import Prelude hiding ((.), id)-import Control.Applicative (Applicative, pure, (<*>), (<$>))-import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)-import Control.Monad.Error (ErrorT, runErrorT)-import Control.Monad ((<=<), liftM2)-import Data.Set (Set)-import qualified Data.Set as S-import Control.Category (Category, (.), id)-import Control.Arrow (Arrow, ArrowChoice, arr, first, left) -import Hakyll.Core.Identifier-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Store-import Hakyll.Core.Routes-import Hakyll.Core.Logger+--------------------------------------------------------------------------------+import Control.Applicative (Alternative (..),+ Applicative (..), (<$>))+import Control.Exception (SomeException, handle)+import Data.Monoid (Monoid (..))+import Data.Set (Set)+import qualified Data.Set as S --- | A set of dependencies----type Dependencies = Set (Identifier ()) --- | Environment in which the dependency analyzer runs----data DependencyEnvironment = DependencyEnvironment- { -- | Target identifier- dependencyIdentifier :: Identifier ()- , -- | List of available identifiers we can depend upon- dependencyUniverse :: [Identifier ()]- }+--------------------------------------------------------------------------------+import Hakyll.Core.Configuration+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Logger+import Hakyll.Core.Metadata+import Hakyll.Core.Provider+import Hakyll.Core.Routes+import Hakyll.Core.Store ++-------------------------------------------------------------------------------- -- | Environment in which a compiler runs----data CompilerEnvironment = CompilerEnvironment- { -- | Target identifier- compilerIdentifier :: Identifier ()+data CompilerRead = CompilerRead+ { -- | Main configuration+ compilerConfig :: Configuration+ , -- | Underlying identifier+ compilerUnderlying :: Identifier , -- | Resource provider- compilerResourceProvider :: ResourceProvider+ compilerProvider :: Provider , -- | List of all known identifiers- compilerUniverse :: [Identifier ()]+ compilerUniverse :: Set Identifier , -- | Site routes- compilerRoutes :: Routes+ compilerRoutes :: Routes , -- | Compiler store- compilerStore :: Store- , -- | Flag indicating if the underlying resource was modified- compilerResourceModified :: Bool+ compilerStore :: Store , -- | Logger- compilerLogger :: Logger+ compilerLogger :: Logger } --- | A calculation possibly throwing an error----type Throwing a = Either String a --- | The compiler monad----newtype CompilerM a = CompilerM- { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a- } deriving (Monad, Functor, Applicative)+--------------------------------------------------------------------------------+data CompilerWrite = CompilerWrite+ { compilerDependencies :: [Dependency]+ , compilerCacheHits :: Int+ } deriving (Show) --- | The compiler arrow----data Compiler a b = Compiler- { compilerDependencies :: Reader DependencyEnvironment Dependencies- , compilerJob :: a -> CompilerM b++--------------------------------------------------------------------------------+instance Monoid CompilerWrite where+ mempty = CompilerWrite [] 0+ mappend (CompilerWrite d1 h1) (CompilerWrite d2 h2) =+ CompilerWrite (d1 ++ d2) (h1 + h2)+++--------------------------------------------------------------------------------+data CompilerResult a where+ CompilerDone :: a -> CompilerWrite -> CompilerResult a+ CompilerError :: String -> CompilerResult a+ CompilerRequire :: Identifier -> Compiler a -> CompilerResult a+++--------------------------------------------------------------------------------+-- | A monad which lets you compile items and takes care of dependency tracking+-- for you.+newtype Compiler a = Compiler+ { unCompiler :: CompilerRead -> IO (CompilerResult a) } -instance Functor (Compiler a) where- fmap f ~(Compiler d j) = Compiler d $ fmap f . j -instance Applicative (Compiler a) where- pure = Compiler (return S.empty) . const . return- ~(Compiler d1 f) <*> ~(Compiler d2 j) =- Compiler (liftM2 S.union d1 d2) $ \x -> f x <*> j x+--------------------------------------------------------------------------------+instance Functor Compiler where+ fmap f (Compiler c) = Compiler $ \r -> do+ res <- c r+ return $ case res of+ CompilerDone x w -> CompilerDone (f x) w+ CompilerError e -> CompilerError e+ CompilerRequire i c' -> CompilerRequire i (fmap f c')+ {-# INLINE fmap #-} -instance Category Compiler where- id = Compiler (return S.empty) return- ~(Compiler d1 j1) . ~(Compiler d2 j2) =- Compiler (liftM2 S.union d1 d2) (j1 <=< j2) -instance Arrow Compiler where- arr f = Compiler (return S.empty) (return . f)- first ~(Compiler d j) = Compiler d $ \(x, y) -> do- x' <- j x- return (x', y)+--------------------------------------------------------------------------------+instance Monad Compiler where+ return x = Compiler $ \_ -> return $ CompilerDone x mempty+ {-# INLINE return #-} -instance ArrowChoice Compiler where- left ~(Compiler d j) = Compiler d $ \e -> case e of- Left l -> Left <$> j l- Right r -> Right <$> return r+ Compiler c >>= f = Compiler $ \r -> do+ res <- c r+ case res of+ CompilerDone x w -> do+ res' <- unCompiler (f x) r+ return $ case res' of+ CompilerDone y w' -> CompilerDone y (w `mappend` w')+ CompilerError e -> CompilerError e+ CompilerRequire i c' -> CompilerRequire i $ do+ compilerTell w -- Save dependencies!+ c' --- | Run a compiler, yielding the resulting target----runCompilerJob :: Compiler () a -- ^ Compiler to run- -> Identifier () -- ^ Target identifier- -> ResourceProvider -- ^ Resource provider- -> [Identifier ()] -- ^ Universe- -> Routes -- ^ Route- -> Store -- ^ Store- -> Bool -- ^ Was the resource modified?- -> Logger -- ^ Logger- -> IO (Throwing a) -- ^ Result-runCompilerJob compiler id' provider universe route store modified logger =- runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env- where- env = CompilerEnvironment- { compilerIdentifier = id'- , compilerResourceProvider = provider- , compilerUniverse = universe- , compilerRoutes = route- , compilerStore = store- , compilerResourceModified = modified- , compilerLogger = logger- }+ CompilerError e -> return $ CompilerError e+ CompilerRequire i c' -> return $ CompilerRequire i $ c' >>= f+ {-# INLINE (>>=) #-} -runCompilerDependencies :: Compiler () a- -> Identifier ()- -> [Identifier ()]- -> Dependencies-runCompilerDependencies compiler identifier universe =- runReader (compilerDependencies compiler) env+ fail = compilerThrow+ {-# INLINE fail #-}+++--------------------------------------------------------------------------------+instance Applicative Compiler where+ pure x = return x+ {-# INLINE pure #-}++ f <*> x = f >>= \f' -> fmap f' x+ {-# INLINE (<*>) #-}+++--------------------------------------------------------------------------------+instance MonadMetadata Compiler where+ getMetadata = compilerGetMetadata+ getMatches = compilerGetMatches+++--------------------------------------------------------------------------------+runCompiler :: Compiler a -> CompilerRead -> IO (CompilerResult a)+runCompiler compiler read' = handle handler $ unCompiler compiler read' where- env = DependencyEnvironment- { dependencyIdentifier = identifier- , dependencyUniverse = universe- }+ handler :: SomeException -> IO (CompilerResult a)+ handler e = return $ CompilerError $ show e -fromJob :: (a -> CompilerM b)- -> Compiler a b-fromJob = Compiler (return S.empty) -fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()])- -> Compiler b b-fromDependencies collectDeps = flip Compiler return $ do- DependencyEnvironment identifier universe <- ask- return $ S.fromList $ collectDeps identifier universe+--------------------------------------------------------------------------------+instance Alternative Compiler where+ empty = compilerThrow "Hakyll.Core.Compiler.Internal: empty alternative"+ x <|> y = compilerCatch x (\_ -> y)+ {-# INLINE (<|>) #-} --- | Wait until another compiler has finished before running this compiler----fromDependency :: Identifier a -> Compiler b b-fromDependency = fromDependencies . const . const . return . castIdentifier++--------------------------------------------------------------------------------+compilerAsk :: Compiler CompilerRead+compilerAsk = Compiler $ \r -> return $ CompilerDone r mempty+{-# INLINE compilerAsk #-}+++--------------------------------------------------------------------------------+compilerTell :: CompilerWrite -> Compiler ()+compilerTell deps = Compiler $ \_ -> return $ CompilerDone () deps+{-# INLINE compilerTell #-}+++--------------------------------------------------------------------------------+compilerThrow :: String -> Compiler a+compilerThrow e = Compiler $ \_ -> return $ CompilerError e+{-# INLINE compilerThrow #-}+++--------------------------------------------------------------------------------+compilerCatch :: Compiler a -> (String -> Compiler a) -> Compiler a+compilerCatch (Compiler x) f = Compiler $ \r -> do+ res <- x r+ case res of+ CompilerError e -> unCompiler (f e) r+ _ -> return res+{-# INLINE compilerCatch #-}+++--------------------------------------------------------------------------------+-- | Put the result back in a compiler+compilerResult :: CompilerResult a -> Compiler a+compilerResult x = Compiler $ \_ -> return x+{-# INLINE compilerResult #-}+++--------------------------------------------------------------------------------+compilerUnsafeIO :: IO a -> Compiler a+compilerUnsafeIO io = Compiler $ \_ -> do+ x <- io+ return $ CompilerDone x mempty+{-# INLINE compilerUnsafeIO #-}+++--------------------------------------------------------------------------------+compilerTellDependencies :: [Dependency] -> Compiler ()+compilerTellDependencies ds = compilerTell mempty {compilerDependencies = ds}+{-# INLINE compilerTellDependencies #-}+++--------------------------------------------------------------------------------+compilerTellCacheHits :: Int -> Compiler ()+compilerTellCacheHits ch = compilerTell mempty {compilerCacheHits = ch}+{-# INLINE compilerTellCacheHits #-}+++--------------------------------------------------------------------------------+compilerGetMetadata :: Identifier -> Compiler Metadata+compilerGetMetadata identifier = do+ provider <- compilerProvider <$> compilerAsk+ compilerTellDependencies [IdentifierDependency identifier]+ compilerUnsafeIO $ resourceMetadata provider identifier+++--------------------------------------------------------------------------------+compilerGetMatches :: Pattern -> Compiler [Identifier]+compilerGetMatches pattern = do+ universe <- compilerUniverse <$> compilerAsk+ let matching = filterMatches pattern $ S.toList universe+ compilerTellDependencies [PatternDependency pattern matching]+ return matching
+ src/Hakyll/Core/Compiler/Require.hs view
@@ -0,0 +1,128 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Compiler.Require+ ( Snapshot+ , save+ , saveSnapshot+ , load+ , loadSnapshot+ , loadBody+ , loadSnapshotBody+ , loadAll+ , loadAllSnapshots+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Monad (when)+import Data.Binary (Binary)+import qualified Data.Set as S+import Data.Typeable+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Item+import Hakyll.Core.Metadata+import Hakyll.Core.Store (Store)+import qualified Hakyll.Core.Store as Store+++--------------------------------------------------------------------------------+-- | Whilst compiling an item, it possible to save multiple snapshots of it, and+-- not just the final result.+type Snapshot = String+++--------------------------------------------------------------------------------+save :: (Binary a, Typeable a) => Store -> Item a -> IO ()+save store item = saveSnapshot store final item+++--------------------------------------------------------------------------------+-- | Save a specific snapshot of an item, so you can load it later using+-- 'loadSnapshot'.+saveSnapshot :: (Binary a, Typeable a)+ => Store -> Snapshot -> Item a -> IO ()+saveSnapshot store snapshot item =+ Store.set store (key (itemIdentifier item) snapshot) (itemBody item)+++--------------------------------------------------------------------------------+-- | Load an item compiled elsewhere. If the required item is not yet compiled,+-- the build system will take care of that automatically.+load :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)+load id' = loadSnapshot id' final+++--------------------------------------------------------------------------------+-- | Require a specific snapshot of an item.+loadSnapshot :: (Binary a, Typeable a)+ => Identifier -> Snapshot -> Compiler (Item a)+loadSnapshot id' snapshot = do+ store <- compilerStore <$> compilerAsk+ universe <- compilerUniverse <$> compilerAsk++ -- Quick check for better error messages+ when (id' `S.notMember` universe) $ compilerThrow notFound++ compilerTellDependencies [IdentifierDependency id']+ compilerResult $ CompilerRequire id' $ do+ result <- compilerUnsafeIO $ Store.get store (key id' snapshot)+ case result of+ Store.NotFound -> compilerThrow notFound+ Store.WrongType e r -> compilerThrow $ wrongType e r+ Store.Found x -> return $ Item id' x+ where+ notFound =+ "Hakyll.Core.Compiler.Require.load: " ++ show id' +++ " (snapshot " ++ snapshot ++ ") was not found in the cache, " +++ "the cache might be corrupted or " +++ "the item you are referring to might not exist"+ wrongType e r =+ "Hakyll.Core.Compiler.Require.load: " ++ show id' +++ " (snapshot " ++ snapshot ++ ") was found in the cache, " +++ "but does not have the right type: expected " ++ show e +++ " but got " ++ show r+++--------------------------------------------------------------------------------+-- | A shortcut for only requiring the body of an item.+--+-- > loadBody = fmap itemBody . load+loadBody :: (Binary a, Typeable a) => Identifier -> Compiler a+loadBody id' = loadSnapshotBody id' final+++--------------------------------------------------------------------------------+loadSnapshotBody :: (Binary a, Typeable a)+ => Identifier -> Snapshot -> Compiler a+loadSnapshotBody id' snapshot = fmap itemBody $ loadSnapshot id' snapshot+++--------------------------------------------------------------------------------+-- | This function allows you to 'load' a dynamic list of items+loadAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]+loadAll pattern = loadAllSnapshots pattern final+++--------------------------------------------------------------------------------+loadAllSnapshots :: (Binary a, Typeable a)+ => Pattern -> Snapshot -> Compiler [Item a]+loadAllSnapshots pattern snapshot = do+ matching <- getMatches pattern+ mapM (\i -> loadSnapshot i snapshot) matching+++--------------------------------------------------------------------------------+key :: Identifier -> String -> [String]+key identifier snapshot =+ ["Hakyll.Core.Compiler.Require", show identifier, snapshot]+++--------------------------------------------------------------------------------+final :: Snapshot+final = "_final"
src/Hakyll/Core/Configuration.hs view
@@ -1,22 +1,31 @@+-------------------------------------------------------------------------------- -- | Exports a datastructure for the top-level hakyll configuration--- module Hakyll.Core.Configuration- ( HakyllConfiguration (..)+ ( Configuration (..) , shouldIgnoreFile- , defaultHakyllConfiguration+ , defaultConfiguration ) where -import System.FilePath (takeFileName)-import Data.List (isPrefixOf, isSuffixOf) -data HakyllConfiguration = HakyllConfiguration+--------------------------------------------------------------------------------+import Data.List (isPrefixOf, isSuffixOf)+import System.FilePath (normalise, takeFileName)+++--------------------------------------------------------------------------------+data Configuration = Configuration { -- | Directory in which the output written destinationDirectory :: FilePath , -- | Directory where hakyll's internal store is kept- storeDirectory :: FilePath+ storeDirectory :: FilePath+ , -- | Directory in which some temporary files will be kept+ tmpDirectory :: FilePath+ , -- | Directory where hakyll finds the files to compile. This is @.@ by+ -- default.+ providerDirectory :: FilePath , -- | Function to determine ignored files --- -- In 'defaultHakyllConfiguration', the following files are ignored:+ -- In 'defaultConfiguration', the following files are ignored: -- -- * files starting with a @.@ --@@ -26,11 +35,11 @@ -- -- * files ending with @.swp@ --- -- Note that the files in @destinationDirectory@ and @storeDirectory@ will+ -- Note that the files in 'destinationDirectory' and 'storeDirectory' will -- also be ignored. Note that this is the configuration parameter, if you- -- want to use the test, you should use @shouldIgnoreFile@.+ -- want to use the test, you should use 'shouldIgnoreFile'. --- ignoreFile :: FilePath -> Bool+ ignoreFile :: FilePath -> Bool , -- | Here, you can plug in a system command to upload/deploy your site. -- -- Example:@@ -39,20 +48,23 @@ -- -- You can execute this by using --- -- > ./hakyll deploy+ -- > ./site deploy --- deployCommand :: String+ deployCommand :: String , -- | Use an in-memory cache for items. This is faster but uses more -- memory.- inMemoryCache :: Bool+ inMemoryCache :: Bool } ++-------------------------------------------------------------------------------- -- | Default configuration for a hakyll application----defaultHakyllConfiguration :: HakyllConfiguration-defaultHakyllConfiguration = HakyllConfiguration+defaultConfiguration :: Configuration+defaultConfiguration = Configuration { destinationDirectory = "_site" , storeDirectory = "_cache"+ , tmpDirectory = "_cache/tmp"+ , providerDirectory = "." , ignoreFile = ignoreFile' , deployCommand = "echo 'No deploy command specified'" , inMemoryCache = True@@ -63,14 +75,18 @@ | "#" `isPrefixOf` fileName = True | "~" `isSuffixOf` fileName = True | ".swp" `isSuffixOf` fileName = True- | otherwise = False+ | otherwise = False where fileName = takeFileName path ++-------------------------------------------------------------------------------- -- | Check if a file should be ignored----shouldIgnoreFile :: HakyllConfiguration -> FilePath -> Bool+shouldIgnoreFile :: Configuration -> FilePath -> Bool shouldIgnoreFile conf path =- destinationDirectory conf `isPrefixOf` path ||- storeDirectory conf `isPrefixOf` path ||- ignoreFile conf path+ destinationDirectory conf `isPrefixOf` path' ||+ storeDirectory conf `isPrefixOf` path' ||+ tmpDirectory conf `isPrefixOf` path' ||+ ignoreFile conf path'+ where+ path' = normalise path
+ src/Hakyll/Core/Dependencies.hs view
@@ -0,0 +1,147 @@+--------------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-}+module Hakyll.Core.Dependencies+ ( Dependency (..)+ , DependencyFacts+ , outOfDate+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>), (<*>))+import Control.Monad (foldM, forM_, unless, when)+import Control.Monad.Reader (ask)+import Control.Monad.RWS (RWS, runRWS)+import qualified Control.Monad.State as State+import Control.Monad.Writer (tell)+import Data.Binary (Binary (..), getWord8,+ putWord8)+import Data.List (find)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Data.Set (Set)+import qualified Data.Set as S+import Data.Typeable (Typeable)+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+++--------------------------------------------------------------------------------+data Dependency+ = PatternDependency Pattern [Identifier]+ | IdentifierDependency Identifier+ deriving (Show, Typeable)+++--------------------------------------------------------------------------------+instance Binary Dependency where+ put (PatternDependency p is) = putWord8 0 >> put p >> put is+ put (IdentifierDependency i) = putWord8 1 >> put i+ get = getWord8 >>= \t -> case t of+ 0 -> PatternDependency <$> get <*> get+ 1 -> IdentifierDependency <$> get+ _ -> error "Data.Binary.get: Invalid Dependency"+++--------------------------------------------------------------------------------+type DependencyFacts = Map Identifier [Dependency]+++--------------------------------------------------------------------------------+outOfDate+ :: [Identifier] -- ^ All known identifiers+ -> Set Identifier -- ^ Initially out-of-date resources+ -> DependencyFacts -- ^ Old dependency facts+ -> (Set Identifier, DependencyFacts, [String])+outOfDate universe ood oldFacts =+ let (_, state, logs) = runRWS rws universe (DependencyState oldFacts ood)+ in (dependencyOod state, dependencyFacts state, logs)+ where+ rws = do+ checkNew+ checkChangedPatterns+ bruteForce+++--------------------------------------------------------------------------------+data DependencyState = DependencyState+ { dependencyFacts :: DependencyFacts+ , dependencyOod :: Set Identifier+ } deriving (Show)+++--------------------------------------------------------------------------------+type DependencyM a = RWS [Identifier] [String] DependencyState a+++--------------------------------------------------------------------------------+markOod :: Identifier -> DependencyM ()+markOod id' = State.modify $ \s ->+ s {dependencyOod = S.insert id' $ dependencyOod s}+++--------------------------------------------------------------------------------+dependenciesFor :: Identifier -> DependencyM [Identifier]+dependenciesFor id' = do+ facts <- dependencyFacts <$> State.get+ return $ concatMap dependenciesFor' $ fromMaybe [] $ M.lookup id' facts+ where+ dependenciesFor' (IdentifierDependency i) = [i]+ dependenciesFor' (PatternDependency _ is) = is+++--------------------------------------------------------------------------------+checkNew :: DependencyM ()+checkNew = do+ universe <- ask+ facts <- dependencyFacts <$> State.get+ forM_ universe $ \id' -> unless (id' `M.member` facts) $ do+ tell [show id' ++ " is out-of-date because it is new"]+ markOod id'+++--------------------------------------------------------------------------------+checkChangedPatterns :: DependencyM ()+checkChangedPatterns = do+ facts <- M.toList . dependencyFacts <$> State.get+ forM_ facts $ \(id', deps) -> do+ deps' <- foldM (go id') [] deps+ State.modify $ \s -> s+ {dependencyFacts = M.insert id' deps' $ dependencyFacts s}+ where+ go _ ds (IdentifierDependency i) = return $ IdentifierDependency i : ds+ go id' ds (PatternDependency p ls) = do+ universe <- ask+ let ls' = filterMatches p universe+ if ls == ls'+ then return $ PatternDependency p ls : ds+ else do+ tell [show id' ++ " is out-of-date because a pattern changed"]+ markOod id'+ return $ PatternDependency p ls' : ds+++--------------------------------------------------------------------------------+bruteForce :: DependencyM ()+bruteForce = do+ todo <- ask+ go todo+ where+ go todo = do+ (todo', changed) <- foldM check ([], False) todo+ when changed (go todo')++ check (todo, changed) id' = do+ deps <- dependenciesFor id'+ ood <- dependencyOod <$> State.get+ case find (`S.member` ood) deps of+ Nothing -> return (id' : todo, changed)+ Just d -> do+ tell [show id' ++ " is out-of-date because " +++ show d ++ " is out-of-date"]+ markOod id'+ return (todo, True)
− src/Hakyll/Core/DependencyAnalyzer.hs
@@ -1,156 +0,0 @@-module Hakyll.Core.DependencyAnalyzer- ( DependencyAnalyzer (..)- , Signal (..)- , makeDependencyAnalyzer- , step- , stepAll- ) where--import Prelude hiding (reverse)-import qualified Prelude as P (reverse)-import Control.Arrow (first)-import Data.Set (Set)-import qualified Data.Set as S-import Data.Monoid (Monoid, mappend, mempty)--import Hakyll.Core.DirectedGraph---- | This data structure represents the state of the dependency analyzer. It--- holds a complete graph in 'analyzerGraph', which always contains all items,--- whether they are to be compiled or not.------ The 'analyzerRemains' fields holds the items that still need to be compiled,--- and 'analyzerDone' holds the items which are already compiled. This means--- that initally, 'analyzerDone' is empty and 'analyzerRemains' contains the--- items which are out-of-date (or items which have out-of-date dependencies).------ We also hold the dependency graph from the previous run because we need it--- when we want to determine when an item is out-of-date. An item is out-of-date--- when:------ * the resource from which it compiles is out-of-date, or;------ * any of it's dependencies is out-of-date, or;------ * it's set of dependencies has changed since the previous run.----data DependencyAnalyzer a = DependencyAnalyzer- { -- | The complete dependency graph- analyzerGraph :: DirectedGraph a- , -- | A set of items yet to be compiled- analyzerRemains :: Set a- , -- | A set of items already compiled- analyzerDone :: Set a- , -- | The dependency graph from the previous run- analyzerPreviousGraph :: DirectedGraph a- } deriving (Show)--data Signal a = Build a- | Cycle [a]- | Done- deriving (Show)--instance (Ord a, Show a) => Monoid (DependencyAnalyzer a) where- mempty = DependencyAnalyzer mempty mempty mempty mempty- mappend x y = growRemains $ DependencyAnalyzer- (analyzerGraph x `mappend` analyzerGraph y)- (analyzerRemains x `mappend` analyzerRemains y)- (analyzerDone x `mappend` analyzerDone y)- (analyzerPreviousGraph x `mappend` analyzerPreviousGraph y)---- | Construct a dependency analyzer----makeDependencyAnalyzer :: (Ord a, Show a)- => DirectedGraph a -- ^ The dependency graph- -> (a -> Bool) -- ^ Is an item out-of-date?- -> DirectedGraph a -- ^ The old dependency graph- -> DependencyAnalyzer a -- ^ Resulting analyzer-makeDependencyAnalyzer graph isOutOfDate prev =- growRemains $ DependencyAnalyzer graph remains S.empty prev- where- -- Construct the remains set by filtering using the given predicate- remains = S.fromList $ filter isOutOfDate $ map fst $ toList graph---- | The 'analyzerRemains' field of a 'DependencyAnalyzer' is supposed to--- contain all out-of-date items, including the items with out-of-date--- dependencies. However, it is easier to just set up the directly out-of-date--- items initially -- and then grow the remains fields.------ This function assumes the 'analyzerRemains' fields in incomplete, and tries--- to correct it. Running it when the field is complete has no effect -- but it--- is a pretty expensive function, and it should be used with care.----growRemains :: (Ord a, Show a) => DependencyAnalyzer a -> DependencyAnalyzer a-growRemains (DependencyAnalyzer graph remains done prev) =- (DependencyAnalyzer graph remains' done prev)- where- -- Grow the remains set using the indirect and changedDeps values, then- -- filter out the items already done- remains' = S.filter (`S.notMember` done) indirect-- -- Select the nodes which are reachable from the remaining nodes in the- -- reversed dependency graph: these are the indirectly out-of-date items- indirect = reachableNodes (remains `S.union` changedDeps) $ reverse graph-- -- For all nodes in the graph, check which items have a different dependency- -- set compared to the previous run- changedDeps = S.fromList $ map fst $- filter (uncurry (/=) . first (`neighbours` prev)) $ toList graph---- | Step a dependency analyzer----step :: (Ord a, Show a) => DependencyAnalyzer a -> (Signal a, DependencyAnalyzer a)-step analyzer@(DependencyAnalyzer graph remains done prev)- -- No remaining items- | S.null remains = (Done, analyzer)- -- An item remains, let's find a ready item- | otherwise =- let item = S.findMin remains- in case findReady analyzer item of- Done -> (Done, analyzer)- Cycle c -> (Cycle c, analyzer)- -- A ready item was found, signal a build- Build build ->- let remains' = S.delete build remains- done' = S.insert build done- in (Build build, DependencyAnalyzer graph remains' done' prev)---- | Step until done, creating a set of items we need to build -- mostly used--- for debugging purposes----stepAll :: (Ord a, Show a) => DependencyAnalyzer a -> Maybe (Set a)-stepAll = stepAll' S.empty- where- stepAll' xs analyzer = case step analyzer of- (Build x, analyzer') -> stepAll' (S.insert x xs) analyzer'- (Done, _) -> Just xs- (Cycle _, _) -> Nothing---- | Find an item ready to be compiled----findReady :: (Ord a, Show a) => DependencyAnalyzer a -> a -> Signal a-findReady analyzer = findReady' [] S.empty- where- -- The dependency graph- graph = analyzerGraph analyzer-- -- Items to do- todo = analyzerRemains analyzer `S.difference` analyzerDone analyzer-- -- Worker- findReady' stack visited item- -- We already visited this item, the cycle is the reversed stack- | item `S.member` visited = Cycle $ P.reverse stack'- -- Look at the neighbours we to do- | otherwise = case filter (`S.member` todo) neighbours' of- -- No neighbours available to be done: it's ready!- [] -> Build item- -- At least one neighbour is available, search for that one- (x : _) -> findReady' stack' visited' x- where- -- Our neighbours- neighbours' = S.toList $ neighbours item graph-- -- The new visited stack/set- stack' = item : stack- visited' = S.insert item visited
− src/Hakyll/Core/DirectedGraph.hs
@@ -1,84 +0,0 @@--- | Representation of a directed graph. In Hakyll, this is used for dependency--- tracking.----module Hakyll.Core.DirectedGraph- ( DirectedGraph- , fromList- , toList- , member- , nodes- , neighbours- , reverse- , reachableNodes- ) where--import Prelude hiding (reverse)-import Control.Arrow (second)-import Data.Monoid (mconcat)-import Data.Set (Set)-import Data.Maybe (fromMaybe)-import qualified Data.Map as M-import qualified Data.Set as S--import Hakyll.Core.DirectedGraph.Internal---- | Construction of directed graphs----fromList :: Ord a- => [(a, Set a)] -- ^ List of (node, reachable neighbours)- -> DirectedGraph a -- ^ Resulting directed graph-fromList = DirectedGraph . M.fromList . map (\(t, d) -> (t, Node t d))---- | Deconstruction of directed graphs----toList :: DirectedGraph a- -> [(a, Set a)]-toList = map (second nodeNeighbours) . M.toList . unDirectedGraph---- | Check if a node lies in the given graph----member :: Ord a- => a -- ^ Node to check for- -> DirectedGraph a -- ^ Directed graph to check in- -> Bool -- ^ If the node lies in the graph-member n = M.member n . unDirectedGraph---- | Get all nodes in the graph----nodes :: Ord a- => DirectedGraph a -- ^ Graph to get the nodes from- -> Set a -- ^ All nodes in the graph-nodes = M.keysSet . unDirectedGraph---- | Get a set of reachable neighbours from a directed graph----neighbours :: Ord a- => a -- ^ Node to get the neighbours of- -> DirectedGraph a -- ^ Graph to search in- -> Set a -- ^ Set containing the neighbours-neighbours x = fromMaybe S.empty . fmap nodeNeighbours- . M.lookup x . unDirectedGraph---- | Reverse a directed graph (i.e. flip all edges)----reverse :: Ord a- => DirectedGraph a- -> DirectedGraph a-reverse = mconcat . map reverse' . M.toList . unDirectedGraph- where- reverse' (id', Node _ neighbours') = fromList $- zip (S.toList neighbours') $ repeat $ S.singleton id'---- | Find all reachable nodes from a given set of nodes in the directed graph----reachableNodes :: Ord a => Set a -> DirectedGraph a -> Set a-reachableNodes set graph = reachable (setNeighbours set) set- where- reachable next visited- | S.null next = visited- | otherwise = reachable (sanitize neighbours') (next `S.union` visited)- where- sanitize = S.filter (`S.notMember` visited)- neighbours' = setNeighbours (sanitize next)-- setNeighbours = S.unions . map (`neighbours` graph) . S.toList
− src/Hakyll/Core/DirectedGraph/Dot.hs
@@ -1,32 +0,0 @@--- | Dump a directed graph in dot format. Used for debugging purposes----module Hakyll.Core.DirectedGraph.Dot- ( toDot- , writeDot- ) where--import Hakyll.Core.DirectedGraph-import qualified Data.Set as S---- | Convert a directed graph into dot format for debugging purposes----toDot :: Ord a- => (a -> String) -- ^ Convert nodes to dot names- -> DirectedGraph a -- ^ Graph to dump- -> String -- ^ Resulting string-toDot showTag graph = unlines $ concat- [ return "digraph dependencies {"- , map showNode (S.toList $ nodes graph)- , concatMap showEdges (S.toList $ nodes graph)- , return "}"- ]- where- showNode node = " \"" ++ showTag node ++ "\";"- showEdges node = map (showEdge node) $ S.toList $ neighbours node graph- showEdge x y = " \"" ++ showTag x ++ "\" -> \"" ++ showTag y ++ "\";"---- | Write out the @.dot@ file to a given file path. See 'toDot' for more--- information.----writeDot :: Ord a => FilePath -> (a -> String) -> DirectedGraph a -> IO ()-writeDot path showTag = writeFile path . toDot showTag
− src/Hakyll/Core/DirectedGraph/Internal.hs
@@ -1,52 +0,0 @@--- | Internal structure of the DirectedGraph type. Not exported outside of the--- library.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.DirectedGraph.Internal- ( Node (..)- , DirectedGraph (..)- ) where--import Prelude hiding (reverse, filter)-import Control.Applicative ((<$>), (<*>))-import Data.Monoid (Monoid, mempty, mappend)-import Data.Set (Set)-import Data.Map (Map)-import qualified Data.Map as M-import qualified Data.Set as S--import Data.Binary (Binary, put, get)-import Data.Typeable (Typeable)---- | A node in the directed graph----data Node a = Node- { nodeTag :: a -- ^ Tag identifying the node- , nodeNeighbours :: Set a -- ^ Edges starting at this node- } deriving (Show, Typeable)--instance (Binary a, Ord a) => Binary (Node a) where- put (Node t n) = put t >> put n- get = Node <$> get <*> get---- | Append two nodes. Useful for joining graphs.----appendNodes :: Ord a => Node a -> Node a -> Node a-appendNodes (Node t1 n1) (Node t2 n2)- | t1 /= t2 = error'- | otherwise = Node t1 (n1 `S.union` n2)- where- error' = error $ "Hakyll.Core.DirectedGraph.Internal.appendNodes: "- ++ "Appending differently tagged nodes"---- | Type used to represent a directed graph----newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}- deriving (Show, Binary, Typeable)---- | Allow users to concatenate different graphs----instance Ord a => Monoid (DirectedGraph a) where- mempty = DirectedGraph M.empty- mappend (DirectedGraph m1) (DirectedGraph m2) = DirectedGraph $- M.unionWith appendNodes m1 m2
+ src/Hakyll/Core/File.hs view
@@ -0,0 +1,89 @@+--------------------------------------------------------------------------------+-- | Exports simple compilers to just copy files+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Hakyll.Core.File+ ( CopyFile (..)+ , copyFileCompiler+ , TmpFile (..)+ , newTmpFile+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Data.Binary (Binary (..))+import Data.Typeable (Typeable)+import System.Directory (copyFile, doesFileExist,+ renameFile)+import System.FilePath ((</>))+import System.Random (randomIO)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Configuration+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import qualified Hakyll.Core.Store as Store+import Hakyll.Core.Util.File+import Hakyll.Core.Writable+++--------------------------------------------------------------------------------+-- | This will copy any file directly by using a system call+data CopyFile = CopyFile+ deriving (Show, Eq, Ord, Typeable)+++--------------------------------------------------------------------------------+instance Binary CopyFile where+ put CopyFile = return ()+ get = return CopyFile+++--------------------------------------------------------------------------------+instance Writable CopyFile where+ write dst item = copyFile (toFilePath $ itemIdentifier item) dst+++--------------------------------------------------------------------------------+copyFileCompiler :: Compiler (Item CopyFile)+copyFileCompiler = makeItem CopyFile+++--------------------------------------------------------------------------------+newtype TmpFile = TmpFile FilePath+ deriving (Typeable)+++--------------------------------------------------------------------------------+instance Binary TmpFile where+ put _ = return ()+ get = error $+ "Hakyll.Core.File.TmpFile: You tried to load a TmpFile, however, " +++ "this is not possible since these are deleted as soon as possible."+++--------------------------------------------------------------------------------+instance Writable TmpFile where+ write dst (Item _ (TmpFile fp)) = renameFile fp dst+++--------------------------------------------------------------------------------+-- | Create a tmp file+newTmpFile :: String -- ^ Suffix and extension+ -> Compiler TmpFile -- ^ Resulting tmp path+newTmpFile suffix = do+ path <- mkPath+ compilerUnsafeIO $ makeDirectories path+ debugCompiler $ "newTmpFile " ++ path+ return $ TmpFile path+ where+ mkPath = do+ rand <- compilerUnsafeIO $ randomIO :: Compiler Int+ tmp <- tmpDirectory . compilerConfig <$> compilerAsk+ let path = tmp </> Store.hash [show rand] ++ "-" ++ suffix+ exists <- compilerUnsafeIO $ doesFileExist path+ if exists then mkPath else return path
src/Hakyll/Core/Identifier.hs view
@@ -1,96 +1,81 @@--- | An identifier is a type used to uniquely identify a resource, target...------ One can think of an identifier as something similar to a file path. An--- identifier is a path as well, with the different elements in the path--- separated by @/@ characters. Examples of identifiers are:+--------------------------------------------------------------------------------+-- | An identifier is a type used to uniquely identify an item. An identifier is+-- conceptually similar to a file path. Examples of identifiers are: -- -- * @posts/foo.markdown@ -- -- * @index@ -- -- * @error/404@------ The most important difference between an 'Identifier' and a file path is that--- the identifier for an item is not necesserily the file path.------ For example, we could have an @index@ identifier, generated by Hakyll. The--- actual file path would be @index.html@, but we identify it using @index@.------ @posts/foo.markdown@ could be an identifier of an item that is rendered to--- @posts/foo.html@. In this case, the identifier is the name of the source--- file of the page.------ An `Identifier` carries the type of the value it identifies. This basically--- means that an @Identifier (Page String)@ refers to a page.------ It is a phantom type parameter, meaning you can safely change this if you--- know what you are doing. You can change the type using the 'castIdentifier'--- function.------ If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Core.Identifier- ( Identifier (..)- , castIdentifier- , parseIdentifier+ ( Identifier+ , fromFilePath , toFilePath- , setGroup+ , identifierVersion+ , setVersion ) where -import Control.Applicative ((<$>), (<*>))-import Control.Monad (mplus)-import Data.Monoid (Monoid, mempty, mappend)-import Data.List (intercalate)-import System.FilePath (dropTrailingPathSeparator, splitPath) -import Data.Binary (Binary, get, put)-import GHC.Exts (IsString, fromString)-import Data.Typeable (Typeable)+--------------------------------------------------------------------------------+import Control.Applicative ((<$>), (<*>))+import Control.DeepSeq (NFData (..))+import Data.List (intercalate)+import System.FilePath (dropTrailingPathSeparator, splitPath) --- | An identifier used to uniquely identify a value----data Identifier a = Identifier- { identifierGroup :: Maybe String- , identifierPath :: String++--------------------------------------------------------------------------------+import Data.Binary (Binary (..))+import Data.Typeable (Typeable)+import GHC.Exts (IsString, fromString)+++--------------------------------------------------------------------------------+data Identifier = Identifier+ { identifierVersion :: Maybe String+ , identifierPath :: String } deriving (Eq, Ord, Typeable) -instance Monoid (Identifier a) where- mempty = Identifier Nothing ""- Identifier g1 p1 `mappend` Identifier g2 p2 =- Identifier (g1 `mplus` g2) (p1 `mappend` p2) -instance Binary (Identifier a) where- put (Identifier g p) = put g >> put p+--------------------------------------------------------------------------------+instance Binary Identifier where+ put (Identifier v p) = put v >> put p get = Identifier <$> get <*> get -instance Show (Identifier a) where- show i@(Identifier Nothing _) = toFilePath i- show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")" -instance IsString (Identifier a) where- fromString = parseIdentifier+--------------------------------------------------------------------------------+instance IsString Identifier where+ fromString = fromFilePath --- | Discard the phantom type parameter of an identifier----castIdentifier :: Identifier a -> Identifier b-castIdentifier (Identifier g p) = Identifier g p-{-# INLINE castIdentifier #-} +--------------------------------------------------------------------------------+instance NFData Identifier where+ rnf (Identifier v p) = rnf v `seq` rnf p `seq` ()+++--------------------------------------------------------------------------------+instance Show Identifier where+ show i = case identifierVersion i of+ Nothing -> toFilePath i+ Just v -> toFilePath i ++ " (" ++ v ++ ")"+++-------------------------------------------------------------------------------- -- | Parse an identifier from a string----parseIdentifier :: String -> Identifier a-parseIdentifier = Identifier Nothing- . intercalate "/" . filter (not . null) . split'+fromFilePath :: String -> Identifier+fromFilePath = Identifier Nothing .+ intercalate "/" . filter (not . null) . split' where split' = map dropTrailingPathSeparator . splitPath ++-------------------------------------------------------------------------------- -- | Convert an identifier to a relative 'FilePath'----toFilePath :: Identifier a -> FilePath+toFilePath :: Identifier -> FilePath toFilePath = identifierPath --- | Set the identifier group for some identifier----setGroup :: Maybe String -> Identifier a -> Identifier a-setGroup g (Identifier _ p) = Identifier g p++--------------------------------------------------------------------------------+setVersion :: Maybe String -> Identifier -> Identifier+setVersion v i = i {identifierVersion = v}
src/Hakyll/Core/Identifier/Pattern.hs view
@@ -1,104 +1,152 @@--- | Module providing pattern matching and capturing on 'Identifier's.--- 'Pattern's come in two kinds:------ * Simple glob patterns, like @foo\/*@;------ * Custom, arbitrary predicates of the type @Identifier -> Bool@.+--------------------------------------------------------------------------------+-- | As 'Identifier' is used to specify a single item, a 'Pattern' is used to+-- specify a list of items. ----- They both have advantages and disadvantages. By default, globs are used,--- unless you construct your 'Pattern' using the 'predicate' function.+-- In most cases, globs are used for patterns. ----- A very simple pattern could be, for example, @foo\/bar@. This pattern will+-- A very simple pattern of such a pattern is @\"foo\/bar\"@. This pattern will -- only match the exact @foo\/bar@ identifier. -- -- To match more than one identifier, there are different captures that one can -- use: ----- * @*@: matches at most one element of an identifier;+-- * @\"*\"@: matches at most one element of an identifier; ----- * @**@: matches one or more elements of an identifier.+-- * @\"**\"@: matches one or more elements of an identifier. -- -- Some examples: ----- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@;+-- * @\"foo\/*\"@ will match @\"foo\/bar\"@ and @\"foo\/foo\"@, but not+-- @\"foo\/bar\/qux\"@; ----- * @**@ will match any identifier;+-- * @\"**\"@ will match any identifier; ----- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@;+-- * @\"foo\/**\"@ will match @\"foo\/bar\"@ and @\"foo\/bar\/qux\"@, but not+-- @\"bar\/foo\"@; ----- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory.+-- * @\"foo\/*.html\"@ will match all HTML files in the @\"foo\/\"@ directory. -- -- The 'capture' function allows the user to get access to the elements captured -- by the capture elements in the pattern.------ Like an 'Identifier', a 'Pattern' also has a type parameter. This is simply--- an extra layer of safety, and can be discarded using the 'castPattern'--- function.--- module Hakyll.Core.Identifier.Pattern ( -- * The pattern type Pattern- , castPattern -- * Creating patterns- , parseGlob- , predicate- , list- , regex- , inGroup+ , fromGlob+ , fromList+ , fromRegex+ , fromVersion+ , hasVersion+ , hasNoVersion++ -- * Composing patterns+ , (.&&.)+ , (.||.) , complement -- * Applying patterns , matches , filterMatches++ -- * Capturing strings , capture , fromCapture , fromCaptures ) where -import Data.List (isPrefixOf, inits, tails)-import Control.Arrow ((&&&), (>>>))-import Control.Monad (msum)-import Data.Maybe (isJust, fromMaybe)-import Data.Monoid (Monoid, mempty, mappend) -import GHC.Exts (IsString, fromString)-import Text.Regex.TDFA ((=~~))+--------------------------------------------------------------------------------+import Control.Applicative (pure, (<$>), (<*>))+import Control.Arrow ((&&&), (>>>))+import Control.Monad (msum)+import Data.Binary (Binary (..), getWord8, putWord8)+import Data.List (inits, isPrefixOf, tails)+import Data.Maybe (isJust)+import Data.Monoid (Monoid, mappend, mempty)+import Data.Set (Set)+import qualified Data.Set as S -import Hakyll.Core.Identifier --- | One base element of a pattern----data GlobComponent = Capture- | CaptureMany- | Literal String- deriving (Eq, Show)+--------------------------------------------------------------------------------+import GHC.Exts (IsString, fromString)+import Text.Regex.TDFA ((=~)) ++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+++--------------------------------------------------------------------------------+-- | Elements of a glob pattern+data GlobComponent+ = Capture+ | CaptureMany+ | Literal String+ deriving (Eq, Show)+++--------------------------------------------------------------------------------+instance Binary GlobComponent where+ put Capture = putWord8 0+ put CaptureMany = putWord8 1+ put (Literal s) = putWord8 2 >> put s++ get = getWord8 >>= \t -> case t of+ 0 -> pure Capture+ 1 -> pure CaptureMany+ 2 -> Literal <$> get+ _ -> error "Data.Binary.get: Invalid GlobComponent"+++-------------------------------------------------------------------------------- -- | Type that allows matching on identifiers----data Pattern a = Glob [GlobComponent]- | Predicate (Identifier a -> Bool)- | List [Identifier a]+data Pattern+ = Everything+ | Complement Pattern+ | And Pattern Pattern+ | Glob [GlobComponent]+ | List (Set Identifier)+ | Regex String+ | Version (Maybe String)+ deriving (Show) -instance IsString (Pattern a) where- fromString = parseGlob -instance Monoid (Pattern a) where- mempty = Predicate (const True)- p1 `mappend` p2 = Predicate $ \i -> matches p1 i && matches p2 i+--------------------------------------------------------------------------------+instance Binary Pattern where+ put Everything = putWord8 0+ put (Complement p) = putWord8 1 >> put p+ put (And x y) = putWord8 2 >> put x >> put y+ put (Glob g) = putWord8 3 >> put g+ put (List is) = putWord8 4 >> put is+ put (Regex r) = putWord8 5 >> put r+ put (Version v) = putWord8 6 >> put v --- | Discard the phantom type parameter----castPattern :: Pattern a -> Pattern b-castPattern (Glob g) = Glob g-castPattern (Predicate p) = Predicate $ p . castIdentifier-castPattern (List l) = List $ map castIdentifier l-{-# INLINE castPattern #-}+ get = getWord8 >>= \t -> case t of+ 0 -> pure Everything+ 1 -> Complement <$> get+ 2 -> And <$> get <*> get+ 3 -> Glob <$> get+ 4 -> List <$> get+ 5 -> Regex <$> get+ _ -> Version <$> get ++--------------------------------------------------------------------------------+instance IsString Pattern where+ fromString = fromGlob+++--------------------------------------------------------------------------------+instance Monoid Pattern where+ mempty = Everything+ mappend = (.&&.)+++-------------------------------------------------------------------------------- -- | Parse a pattern from a string----parseGlob :: String -> Pattern a-parseGlob = Glob . parse'+fromGlob :: String -> Pattern+fromGlob = Glob . parse' where parse' str = let (chunk, rest) = break (`elem` "\\*") str@@ -108,70 +156,120 @@ ('*' : xs) -> Literal chunk : Capture : parse' xs xs -> Literal chunk : Literal xs : [] --- | Create a 'Pattern' from an arbitrary predicate++--------------------------------------------------------------------------------+-- | Create a 'Pattern' from a list of 'Identifier's it should match. ----- Example:+-- /Warning/: use this carefully with 'hasNoVersion' and 'hasVersion'. The+-- 'Identifier's in the list /already/ have versions assigned, and the pattern+-- will then only match the intersection of both versions. ----- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i))+-- A more concrete example, ---predicate :: (Identifier a -> Bool) -> Pattern a-predicate = Predicate---- | Create a 'Pattern' from a list of 'Identifier's it should match+-- > fromList ["foo.markdown"] .&&. hasVersion "pdf" ---list :: [Identifier a] -> Pattern a-list = List+-- will not match anything! The @"foo.markdown"@ 'Identifier' has no version+-- assigned, so the LHS of '.&&.' will only match this 'Identifier' with no+-- version. The RHS only matches 'Identifier's with version set to @"pdf"@ --+-- hence, this pattern matches nothing.+--+-- The correct way to use this is:+--+-- > fromList $ map (setVersion $ Just "pdf") ["foo.markdown"]+fromList :: [Identifier] -> Pattern+fromList = List . S.fromList ++-------------------------------------------------------------------------------- -- | Create a 'Pattern' from a regex -- -- Example: -- -- > regex "^foo/[^x]*$+fromRegex :: String -> Pattern+fromRegex = Regex+++--------------------------------------------------------------------------------+-- | Create a pattern which matches all items with the given version.+fromVersion :: Maybe String -> Pattern+fromVersion = Version+++--------------------------------------------------------------------------------+-- | Specify a version, e.g. ---regex :: String -> Pattern a-regex str = predicate $ fromMaybe False . (=~~ str) . toFilePath+-- > "foo/*.markdown" .&&. hasVersion "pdf"+hasVersion :: String -> Pattern+hasVersion = fromVersion . Just --- | Create a 'Pattern' which matches if the identifier is in a certain group--- (or in no group)++--------------------------------------------------------------------------------+-- | Match only if the identifier has no version set, e.g. ---inGroup :: Maybe String -> Pattern a-inGroup group = predicate $ (== group) . identifierGroup+-- > "foo/*.markdown" .&&. hasNoVersion+hasNoVersion :: Pattern+hasNoVersion = fromVersion Nothing ++--------------------------------------------------------------------------------+-- | '&&' for patterns: the given identifier must match both subterms+(.&&.) :: Pattern -> Pattern -> Pattern+x .&&. y = And x y+infixr 3 .&&.+++--------------------------------------------------------------------------------+-- | '||' for patterns: the given identifier must match any subterm+(.||.) :: Pattern -> Pattern -> Pattern+x .||. y = complement (complement x `And` complement y) -- De Morgan's law+infixr 2 .||.+++-------------------------------------------------------------------------------- -- | Inverts a pattern, e.g. -- -- > complement "foo/bar.html" -- -- will match /anything/ except @\"foo\/bar.html\"@----complement :: Pattern a -> Pattern a-complement p = predicate (not . matches p)+complement :: Pattern -> Pattern+complement = Complement ++-------------------------------------------------------------------------------- -- | Check if an identifier matches a pattern----matches :: Pattern a -> Identifier a -> Bool-matches (Glob p) = isJust . capture (Glob p)-matches (Predicate p) = (p $)-matches (List l) = (`elem` l)+matches :: Pattern -> Identifier -> Bool+matches Everything _ = True+matches (Complement p) i = not $ matches p i+matches (And x y) i = matches x i && matches y i+matches (Glob p) i = isJust $ capture (Glob p) i+matches (List l) i = i `S.member` l+matches (Regex r) i = toFilePath i =~ r+matches (Version v) i = identifierVersion i == v ++-------------------------------------------------------------------------------- -- | Given a list of identifiers, retain only those who match the given pattern----filterMatches :: Pattern a -> [Identifier a] -> [Identifier a]+filterMatches :: Pattern -> [Identifier] -> [Identifier] filterMatches = filter . matches ++-------------------------------------------------------------------------------- -- | Split a list at every possible point, generate a list of (init, tail) -- cases. The result is sorted with inits decreasing in length.--- splits :: [a] -> [([a], [a])] splits = inits &&& tails >>> uncurry zip >>> reverse ++-------------------------------------------------------------------------------- -- | Match a glob against a pattern, generating a list of captures----capture :: Pattern a -> Identifier a -> Maybe [String]-capture (Glob p) (Identifier _ i) = capture' p i-capture _ _ = Nothing+capture :: Pattern -> Identifier -> Maybe [String]+capture (Glob p) i = capture' p (toFilePath i)+capture _ _ = Nothing ++-------------------------------------------------------------------------------- -- | Internal verion of 'capture'--- capture' :: [GlobComponent] -> String -> Maybe [String] capture' [] [] = Just [] -- An empty match capture' [] _ = Nothing -- No match@@ -186,7 +284,9 @@ capture' (CaptureMany : ms) str = -- Match everything msum $ [ fmap (i :) (capture' ms t) | (i, t) <- splits str ]- +++-------------------------------------------------------------------------------- -- | Create an identifier from a pattern by filling in the captures with a given -- string --@@ -197,21 +297,22 @@ -- Result: -- -- > "tags/foo"----fromCapture :: Pattern a -> String -> Identifier a+fromCapture :: Pattern -> String -> Identifier fromCapture pattern = fromCaptures pattern . repeat ++-------------------------------------------------------------------------------- -- | Create an identifier from a pattern by filling in the captures with the -- given list of strings----fromCaptures :: Pattern a -> [String] -> Identifier a-fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p+fromCaptures :: Pattern -> [String] -> Identifier+fromCaptures (Glob p) = fromFilePath . fromCaptures' p fromCaptures _ = error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++ "on simple globs!" ++-------------------------------------------------------------------------------- -- | Internally used version of 'fromCaptures'--- fromCaptures' :: [GlobComponent] -> [String] -> String fromCaptures' [] _ = mempty fromCaptures' (m : ms) [] = case m of
+ src/Hakyll/Core/Item.hs view
@@ -0,0 +1,65 @@+--------------------------------------------------------------------------------+-- | An item is a combination of some content and its 'Identifier'. This way, we+-- can still use the 'Identifier' to access metadata.+{-# LANGUAGE DeriveDataTypeable #-}+module Hakyll.Core.Item+ ( Item (..)+ , itemSetBody+ , withItemBody+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative (Applicative, (<$>), (<*>))+import Data.Binary (Binary (..))+import Data.Foldable (Foldable (..))+import Data.Traversable (Traversable (..))+import Data.Typeable (Typeable)+import Prelude hiding (foldr)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Identifier+++--------------------------------------------------------------------------------+data Item a = Item+ { itemIdentifier :: Identifier+ , itemBody :: a+ } deriving (Show, Typeable)+++--------------------------------------------------------------------------------+instance Functor Item where+ fmap f (Item i x) = Item i (f x)+++--------------------------------------------------------------------------------+instance Foldable Item where+ foldr f z (Item _ x) = f x z+++--------------------------------------------------------------------------------+instance Traversable Item where+ traverse f (Item i x) = Item i <$> f x+++--------------------------------------------------------------------------------+instance Binary a => Binary (Item a) where+ put (Item i x) = put i >> put x+ get = Item <$> get <*> get+++--------------------------------------------------------------------------------+itemSetBody :: a -> Item b -> Item a+itemSetBody x (Item i _) = Item i x+++--------------------------------------------------------------------------------+-- | Perform a compiler action on the item body. This is the same as 'traverse',+-- but looks less intimidating.+--+-- > withItemBody = traverse+withItemBody :: (a -> Compiler b) -> Item a -> Compiler (Item b)+withItemBody = traverse
+ src/Hakyll/Core/Item/SomeItem.hs view
@@ -0,0 +1,23 @@+--------------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+module Hakyll.Core.Item.SomeItem+ ( SomeItem (..)+ ) where+++--------------------------------------------------------------------------------+import Data.Binary (Binary)+import Data.Typeable (Typeable)+++--------------------------------------------------------------------------------+import Hakyll.Core.Item+import Hakyll.Core.Writable+++--------------------------------------------------------------------------------+-- | An existential type, mostly for internal usage.+data SomeItem = forall a.+ (Binary a, Typeable a, Writable a) => SomeItem (Item a)+ deriving (Typeable)
src/Hakyll/Core/Logger.hs view
@@ -1,40 +1,52 @@+-------------------------------------------------------------------------------- -- | Produce pretty, thread-safe logs----{-# LANGUAGE BangPatterns #-} module Hakyll.Core.Logger- ( Logger- , makeLogger- , flushLogger- , section- , timed- , report- , thrown+ ( Verbosity (..)+ , Logger+ , new+ , flush+ , error+ , header+ , message+ , debug ) where -import Control.Monad (forever)-import Control.Monad.Trans (MonadIO, liftIO)-import Control.Applicative (pure, (<$>), (<*>))-import Control.Concurrent (forkIO)-import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)-import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar)-import Text.Printf (printf) -import Data.Time (getCurrentTime, diffUTCTime)+--------------------------------------------------------------------------------+import Control.Applicative (pure, (<$>), (<*>))+import Control.Concurrent (forkIO)+import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar)+import Control.Monad (forever)+import Control.Monad.Trans (MonadIO, liftIO)+import Prelude hiding (error) ++--------------------------------------------------------------------------------+data Verbosity+ = Error+ | Message+ | Debug+ deriving (Eq, Ord, Show)+++-------------------------------------------------------------------------------- -- | Logger structure. Very complicated.--- data Logger = Logger- { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end- , loggerSync :: MVar () -- ^ Used for sync on quit- , loggerSink :: String -> IO () -- ^ Out sink+ { loggerChan :: Chan (Maybe String) -- ^ Nothing marks the end+ , loggerSync :: MVar () -- ^ Used for sync on quit+ , loggerSink :: String -> IO () -- ^ Out sink+ , loggerVerbosity :: Verbosity -- ^ Verbosity } ++-------------------------------------------------------------------------------- -- | Create a new logger----makeLogger :: (String -> IO ()) -> IO Logger-makeLogger sink = do- logger <- Logger <$> newChan <*> newEmptyMVar <*> pure sink- _ <- forkIO $ loggerThread logger+new :: Verbosity -> IO Logger+new vbty = do+ logger <- Logger <$>+ newChan <*> newEmptyMVar <*> pure putStrLn <*> pure vbty+ _ <- forkIO $ loggerThread logger return logger where loggerThread logger = forever $ do@@ -45,56 +57,42 @@ -- Print and continue Just m -> loggerSink logger m ++-------------------------------------------------------------------------------- -- | Flush the logger (blocks until flushed)----flushLogger :: Logger -> IO ()-flushLogger logger = do+flush :: Logger -> IO ()+flush logger = do writeChan (loggerChan logger) Nothing () <- takeMVar $ loggerSync logger return () --- | Send a raw message to the logger----message :: Logger -> String -> IO ()-message logger = writeChan (loggerChan logger) . Just --- | Start a section in the log----section :: MonadIO m- => Logger -- ^ Logger- -> String -- ^ Section name- -> m () -- ^ No result-section logger = liftIO . message logger+--------------------------------------------------------------------------------+string :: MonadIO m+ => Logger -- ^ Logger+ -> Verbosity -- ^ Verbosity of the string+ -> String -- ^ Section name+ -> m () -- ^ No result+string l v m+ | loggerVerbosity l >= v = liftIO $ writeChan (loggerChan l) (Just m)+ | otherwise = return () --- | Execute a monadic action and log the duration----timed :: MonadIO m- => Logger -- ^ Logger- -> String -- ^ Message- -> m a -- ^ Action- -> m a -- ^ Timed and logged action-timed logger msg action = do- start <- liftIO getCurrentTime- !result <- action- stop <- liftIO getCurrentTime- let diff = fromEnum $ diffUTCTime stop start- ms = diff `div` 10 ^ (9 :: Int)- formatted = printf " [%4dms] %s" ms msg- liftIO $ message logger formatted- return result --- | Log something at the same level as 'timed', but without the timing----report :: MonadIO m- => Logger -- ^ Logger- -> String -- ^ Message- -> m () -- ^ No result-report logger msg = liftIO $ message logger $ " [ ] " ++ msg+--------------------------------------------------------------------------------+error :: MonadIO m => Logger -> String -> m ()+error l m = string l Error $ " [ERROR] " ++ m --- | Log an error that was thrown in the compilation phase----thrown :: MonadIO m- => Logger -- ^ Logger- -> String -- ^ Message- -> m () -- ^ No result-thrown logger msg = liftIO $ message logger $ " [ ERROR] " ++ msg++--------------------------------------------------------------------------------+header :: MonadIO m => Logger -> String -> m ()+header l = string l Message+++--------------------------------------------------------------------------------+message :: MonadIO m => Logger -> String -> m ()+message l m = string l Message $ " " ++ m+++--------------------------------------------------------------------------------+debug :: MonadIO m => Logger -> String -> m ()+debug l m = string l Debug $ " [DEBUG] " ++ m
+ src/Hakyll/Core/Metadata.hs view
@@ -0,0 +1,32 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Metadata+ ( Metadata+ , MonadMetadata (..)+ ) where+++--------------------------------------------------------------------------------+import Control.Monad (forM)+import Data.Map (Map)+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+++--------------------------------------------------------------------------------+type Metadata = Map String String+++--------------------------------------------------------------------------------+class Monad m => MonadMetadata m where+ getMetadata :: Identifier -> m Metadata+ getMatches :: Pattern -> m [Identifier]++ getAllMetadata :: Pattern -> m [(Identifier, Metadata)]+ getAllMetadata pattern = do+ matches' <- getMatches pattern+ forM matches' $ \id' -> do+ metadata <- getMetadata id'+ return (id', metadata)
+ src/Hakyll/Core/Provider.hs view
@@ -0,0 +1,46 @@+--------------------------------------------------------------------------------+-- | This module provides an wrapper API around the file system which does some+-- caching.+module Hakyll.Core.Provider+ ( -- * Constructing resource providers+ Provider+ , newProvider++ -- * Querying resource properties+ , resourceList+ , resourceExists+ , resourceModified+ , resourceModificationTime++ -- * Access to raw resource content+ , resourceString+ , resourceLBS++ -- * Access to metadata and body content+ , resourceMetadata+ , resourceBody+ ) where+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Metadata+import Hakyll.Core.Provider.Internal+import qualified Hakyll.Core.Provider.MetadataCache as Internal+import Hakyll.Core.Provider.Modified+++--------------------------------------------------------------------------------+-- | Wrapper to ensure metadata cache is invalidated if necessary+resourceMetadata :: Provider -> Identifier -> IO Metadata+resourceMetadata rp r = do+ _ <- resourceModified rp r+ Internal.resourceMetadata rp r+++--------------------------------------------------------------------------------+-- | Wrapper to ensure metadata cache is invalidated if necessary+resourceBody :: Provider -> Identifier -> IO String+resourceBody rp r = do+ _ <- resourceModified rp r+ Internal.resourceBody rp r
+ src/Hakyll/Core/Provider/Internal.hs view
@@ -0,0 +1,94 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Provider.Internal+ ( Provider (..)+ , newProvider++ , resourceList+ , resourceExists+ , resourceMetadataResource++ , resourceFilePath+ , resourceString+ , resourceLBS+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import qualified Data.ByteString.Lazy as BL+import Data.IORef+import Data.Map (Map)+import qualified Data.Map as M+import Data.Set (Set)+import qualified Data.Set as S+import System.FilePath (addExtension, (</>))+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Store+import Hakyll.Core.Util.File+++--------------------------------------------------------------------------------+-- | Responsible for retrieving and listing resources+data Provider = Provider+ { -- Top of the provided directory+ providerDirectory :: FilePath+ , -- | A list of all files found+ providerSet :: Set Identifier+ , -- | Cache keeping track of modified files+ providerModifiedCache :: IORef (Map Identifier Bool)+ , -- | Underlying persistent store for caching+ providerStore :: Store+ }+++--------------------------------------------------------------------------------+-- | Create a resource provider+newProvider :: Store -- ^ Store to use+ -> (FilePath -> Bool) -- ^ Should we ignore this file?+ -> FilePath -- ^ Search directory+ -> IO Provider -- ^ Resulting provider+newProvider store ignore directory = do+ list <- map fromFilePath . filter (not . ignore) <$>+ getRecursiveContents directory+ cache <- newIORef M.empty+ return $ Provider directory (S.fromList list) cache store+++--------------------------------------------------------------------------------+resourceList :: Provider -> [Identifier]+resourceList = S.toList . providerSet+++--------------------------------------------------------------------------------+-- | Check if a given resource exists+resourceExists :: Provider -> Identifier -> Bool+resourceExists provider =+ (`S.member` providerSet provider) . setVersion Nothing+++--------------------------------------------------------------------------------+-- | Each resource may have an associated metadata resource (with a @.metadata@+-- filename)+resourceMetadataResource :: Identifier -> Identifier+resourceMetadataResource =+ fromFilePath . flip addExtension "metadata" . toFilePath+++--------------------------------------------------------------------------------+resourceFilePath :: Provider -> Identifier -> FilePath+resourceFilePath p i = providerDirectory p </> toFilePath i+++--------------------------------------------------------------------------------+-- | Get the raw body of a resource as string+resourceString :: Provider -> Identifier -> IO String+resourceString p i = readFile $ resourceFilePath p i+++--------------------------------------------------------------------------------+-- | Get the raw body of a resource of a lazy bytestring+resourceLBS :: Provider -> Identifier -> IO BL.ByteString+resourceLBS p i = BL.readFile $ resourceFilePath p i
+ src/Hakyll/Core/Provider/Metadata.hs view
@@ -0,0 +1,125 @@+--------------------------------------------------------------------------------+-- | Internal module to parse metadata+module Hakyll.Core.Provider.Metadata+ ( loadMetadata+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative+import Control.Arrow (second)+import qualified Data.ByteString.Char8 as BC+import qualified Data.Map as M+import System.IO as IO+import Text.Parsec ((<?>))+import qualified Text.Parsec as P+import Text.Parsec.String (Parser)+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Metadata+import Hakyll.Core.Provider.Internal+import Hakyll.Core.Util.String+++--------------------------------------------------------------------------------+loadMetadata :: Provider -> Identifier -> IO (Metadata, Maybe String)+loadMetadata p identifier = do+ hasHeader <- probablyHasMetadataHeader fp+ (md, body) <- if hasHeader+ then second Just <$> loadMetadataHeader fp+ else return (M.empty, Nothing)++ emd <- if resourceExists p mi then loadMetadataFile mfp else return M.empty++ return (M.union md emd, body)+ where+ fp = resourceFilePath p identifier+ mi = resourceMetadataResource identifier+ mfp = resourceFilePath p mi+++--------------------------------------------------------------------------------+loadMetadataHeader :: FilePath -> IO (Metadata, String)+loadMetadataHeader fp = do+ contents <- readFile fp+ case P.parse page fp contents of+ Left err -> error (show err)+ Right (md, b) -> return (M.fromList md, b)+++--------------------------------------------------------------------------------+loadMetadataFile :: FilePath -> IO Metadata+loadMetadataFile fp = do+ contents <- readFile fp+ case P.parse metadata fp contents of+ Left err -> error (show err)+ Right md -> return $ M.fromList md+++--------------------------------------------------------------------------------+-- | Check if a file "probably" has a metadata header. The main goal of this is+-- to exclude binary files (which are unlikely to start with "---").+probablyHasMetadataHeader :: FilePath -> IO Bool+probablyHasMetadataHeader fp = do+ handle <- IO.openFile fp IO.ReadMode+ bs <- BC.hGet handle 1024+ IO.hClose handle+ return $ isMetadataHeader bs+ where+ isMetadataHeader bs =+ let pre = BC.takeWhile (\x -> x /= '\n' && x /= '\r') bs+ in BC.length pre >= 3 && BC.all (== '-') pre+++--------------------------------------------------------------------------------+-- | Space or tab, no newline+inlineSpace :: Parser Char+inlineSpace = P.oneOf ['\t', ' '] <?> "space"+++--------------------------------------------------------------------------------+-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")+newline :: Parser String+newline = P.string "\n" <|> P.string "\r\n"+++--------------------------------------------------------------------------------+-- | Parse a single metadata field+metadataField :: Parser (String, String)+metadataField = do+ key <- P.manyTill P.alphaNum $ P.char ':'+ P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key+ value <- P.manyTill P.anyChar newline+ trailing' <- P.many trailing+ return (key, trim $ value ++ concat trailing')+ where+ trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline+++--------------------------------------------------------------------------------+-- | Parse a metadata block+metadata :: Parser [(String, String)]+metadata = P.many metadataField+++--------------------------------------------------------------------------------+-- | Parse a metadata block, including delimiters and trailing newlines+metadataBlock :: Parser [(String, String)]+metadataBlock = do+ open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline+ metadata' <- metadata+ _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']+ P.skipMany inlineSpace+ P.skipMany1 newline+ return metadata'+++--------------------------------------------------------------------------------+-- | Parse a page consisting of a metadata header and a body+page :: Parser ([(String, String)], String)+page = do+ metadata' <- P.option [] metadataBlock+ body <- P.many P.anyChar+ return (metadata', body)
+ src/Hakyll/Core/Provider/MetadataCache.hs view
@@ -0,0 +1,68 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Provider.MetadataCache+ ( resourceMetadata+ , resourceBody+ , resourceInvalidateMetadataCache+ ) where+++--------------------------------------------------------------------------------+import qualified Data.Map as M+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Metadata+import Hakyll.Core.Provider.Internal+import Hakyll.Core.Provider.Metadata+import qualified Hakyll.Core.Store as Store+++--------------------------------------------------------------------------------+resourceMetadata :: Provider -> Identifier -> IO Metadata+resourceMetadata p r+ | not (resourceExists p r) = return M.empty+ | otherwise = do+ load p r+ Store.Found md <- Store.get (providerStore p)+ [name, toFilePath r, "metadata"]+ return md+++--------------------------------------------------------------------------------+resourceBody :: Provider -> Identifier -> IO String+resourceBody p r = do+ load p r+ Store.Found bd <- Store.get (providerStore p)+ [name, toFilePath r, "body"]+ maybe (resourceString p r) return bd+++--------------------------------------------------------------------------------+resourceInvalidateMetadataCache :: Provider -> Identifier -> IO ()+resourceInvalidateMetadataCache p r = do+ Store.delete (providerStore p) [name, toFilePath r, "metadata"]+ Store.delete (providerStore p) [name, toFilePath r, "body"]+++--------------------------------------------------------------------------------+load :: Provider -> Identifier -> IO ()+load p r = do+ mmd <- Store.get store mdk :: IO (Store.Result Metadata)+ case mmd of+ -- Already loaded+ Store.Found _ -> return ()+ -- Not yet loaded+ _ -> do+ (metadata, body) <- loadMetadata p r+ Store.set store mdk metadata+ Store.set store bk body+ where+ store = providerStore p+ mdk = [name, toFilePath r, "metadata"]+ bk = [name, toFilePath r, "body"]+++--------------------------------------------------------------------------------+name :: String+name = "Hakyll.Core.Resource.Provider.MetadataCache"
+ src/Hakyll/Core/Provider/Modified.hs view
@@ -0,0 +1,101 @@+--------------------------------------------------------------------------------+{-# LANGUAGE CPP #-}+module Hakyll.Core.Provider.Modified+ ( resourceModified+ , resourceModificationTime+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>), (<*>))+import Control.Monad (when)+import qualified Crypto.Hash.MD5 as MD5+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.IORef+import qualified Data.Map as M+import Data.Time (UTCTime)+import System.Directory (getModificationTime)+++--------------------------------------------------------------------------------+#if !MIN_VERSION_directory(1,2,0)+import Data.Time (readTime)+import System.Locale (defaultTimeLocale)+import System.Time (formatCalendarTime,+ toCalendarTime)+#endif+++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Provider.Internal+import Hakyll.Core.Provider.MetadataCache+import Hakyll.Core.Store (Store)+import qualified Hakyll.Core.Store as Store+++--------------------------------------------------------------------------------+-- | A resource is modified if it or its metadata has changed+resourceModified :: Provider -> Identifier -> IO Bool+resourceModified p r+ | not exists = return False+ | otherwise = do+ cache <- readIORef cacheRef+ case M.lookup normalized cache of+ Just m -> return m+ Nothing -> do+ -- Check if the actual file was modified, and do a recursive+ -- call to check if the metadata file was modified+ m <- (||)+ <$> fileDigestModified store filePath+ <*> resourceModified p (resourceMetadataResource r)+ modifyIORef cacheRef (M.insert normalized m)++ -- Important! (But ugly)+ when m $ resourceInvalidateMetadataCache p r++ return m+ where+ normalized = setVersion Nothing r+ exists = resourceExists p r+ store = providerStore p+ cacheRef = providerModifiedCache p+ filePath = resourceFilePath p r+++--------------------------------------------------------------------------------+-- | Utility: Check if a the digest of a file was modified+fileDigestModified :: Store -> FilePath -> IO Bool+fileDigestModified store fp = do+ -- Get the latest seen digest from the store, and calculate the current+ -- digest for the+ lastDigest <- Store.get store key+ newDigest <- fileDigest fp+ if Store.Found newDigest == lastDigest+ -- All is fine, not modified+ then return False+ -- Resource modified; store new digest+ else do+ Store.set store key newDigest+ return True+ where+ key = ["Hakyll.Core.Resource.Provider.fileModified", fp]+++--------------------------------------------------------------------------------+-- | Utility: Retrieve a digest for a given file+fileDigest :: FilePath -> IO B.ByteString+fileDigest = fmap MD5.hashlazy . BL.readFile+++--------------------------------------------------------------------------------+resourceModificationTime :: Provider -> Identifier -> IO UTCTime+resourceModificationTime p i = do+#if MIN_VERSION_directory(1,2,0)+ getModificationTime $ resourceFilePath p i+#else+ ct <- toCalendarTime =<< getModificationTime (resourceFilePath p i)+ let str = formatCalendarTime defaultTimeLocale "%s" ct+ return $ readTime defaultTimeLocale "%s" str+#endif
− src/Hakyll/Core/Resource.hs
@@ -1,31 +0,0 @@--- | Module exporting the simple 'Resource' type----module Hakyll.Core.Resource- ( Resource- , unResource- , resource- , fromIdentifier- , toIdentifier- ) where--import Hakyll.Core.Identifier---- | A resource----newtype Resource = Resource {unResource :: FilePath}- deriving (Eq, Show, Ord)---- | Smart constructor to ensure we have @/@ as path separator----resource :: FilePath -> Resource-resource = fromIdentifier . parseIdentifier---- | Create a resource from an identifier----fromIdentifier :: Identifier a -> Resource-fromIdentifier = Resource . toFilePath---- | Map the resource to an identifier. Note that the group will not be set!----toIdentifier :: Resource -> Identifier a-toIdentifier = parseIdentifier . unResource
− src/Hakyll/Core/Resource/Provider.hs
@@ -1,125 +0,0 @@------------------------------------------------------------------------------------ | This module provides an API for resource providers. Resource providers--- allow Hakyll to get content from resources; the type of resource depends on--- the concrete instance.------ A resource is represented by the 'Resource' type. This is basically just a--- newtype wrapper around 'Identifier' -- but it has an important effect: it--- guarantees that a resource with this identifier can be provided by one or--- more resource providers.------ Therefore, it is not recommended to read files directly -- you should use the--- provided 'Resource' methods.----module Hakyll.Core.Resource.Provider- ( ResourceProvider (..)- , resourceList- , makeResourceProvider- , resourceExists- , resourceDigest- , resourceModified- ) where------------------------------------------------------------------------------------import Control.Applicative ((<$>))-import Control.Concurrent (MVar, readMVar, modifyMVar_, newMVar)-import Data.Map (Map)-import qualified Data.Map as M-import qualified Data.Set as S------------------------------------------------------------------------------------import Data.Time (UTCTime)-import qualified Crypto.Hash.MD5 as MD5-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as LB------------------------------------------------------------------------------------import Hakyll.Core.Store (Store)-import Hakyll.Core.Resource-import qualified Hakyll.Core.Store as Store-------------------------------------------------------------------------------------- | A value responsible for retrieving and listing resources-data ResourceProvider = ResourceProvider- { -- | A set of all resources this provider is able to provide- resourceSet :: S.Set Resource- , -- | Retrieve a certain resource as string- resourceString :: Resource -> IO String- , -- | Retrieve a certain resource as lazy bytestring- resourceLBS :: Resource -> IO LB.ByteString- , -- | Check when a resource was last modified- resourceModificationTime :: Resource -> IO UTCTime- , -- | Cache keeping track of modified items- resourceModifiedCache :: MVar (Map Resource Bool)- }-------------------------------------------------------------------------------------- | Create a resource provider-makeResourceProvider :: [Resource] -- ^ Resource list- -> (Resource -> IO String) -- ^ String reader- -> (Resource -> IO LB.ByteString) -- ^ ByteString reader- -> (Resource -> IO UTCTime) -- ^ Time checker- -> IO ResourceProvider -- ^ Resulting provider-makeResourceProvider l s b t =- ResourceProvider (S.fromList l) s b t <$> newMVar M.empty-------------------------------------------------------------------------------------- | Get the list of all resources-resourceList :: ResourceProvider -> [Resource]-resourceList = S.toList . resourceSet-------------------------------------------------------------------------------------- | Check if a given identifier has a resource-resourceExists :: ResourceProvider -> Resource -> Bool-resourceExists provider = flip S.member $ resourceSet provider-------------------------------------------------------------------------------------- | Retrieve a digest for a given resource-resourceDigest :: ResourceProvider -> Resource -> IO B.ByteString-resourceDigest provider = fmap MD5.hashlazy . resourceLBS provider-------------------------------------------------------------------------------------- | Check if a resource was modified-resourceModified :: ResourceProvider -> Store -> Resource -> IO Bool-resourceModified provider store r = do- cache <- readMVar mvar- case M.lookup r cache of- -- Already in the cache- Just m -> return m- -- Not yet in the cache, check digests (if it exists)- Nothing -> do- m <- if resourceExists provider r- then digestModified provider store r- else return False- modifyMVar_ mvar (return . M.insert r m)- return m- where- mvar = resourceModifiedCache provider-------------------------------------------------------------------------------------- | Check if a resource digest was modified-digestModified :: ResourceProvider -> Store -> Resource -> IO Bool-digestModified provider store r = do- -- Get the latest seen digest from the store- lastDigest <- Store.get store key- -- Calculate the digest for the resource- newDigest <- resourceDigest provider r- -- Check digests- if Store.Found newDigest == lastDigest- -- All is fine, not modified- then return False- -- Resource modified; store new digest- else do Store.set store key newDigest- return True- where- key = ["Hakyll.Core.ResourceProvider.digestModified", unResource r]
− src/Hakyll/Core/Resource/Provider/Dummy.hs
@@ -1,25 +0,0 @@--- | Dummy resource provider for testing purposes----module Hakyll.Core.Resource.Provider.Dummy- ( dummyResourceProvider- ) where--import Data.Map (Map)-import qualified Data.Map as M--import Data.Time (getCurrentTime)-import Data.ByteString.Lazy (ByteString)-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider---- | Create a dummy 'ResourceProvider'----dummyResourceProvider :: Map String ByteString -> IO ResourceProvider-dummyResourceProvider vfs = makeResourceProvider- (map resource (M.keys vfs))- (return . TL.unpack . TL.decodeUtf8 . (vfs M.!) . unResource)- (return . (vfs M.!) . unResource)- (const getCurrentTime)
− src/Hakyll/Core/Resource/Provider/File.hs
@@ -1,39 +0,0 @@--- | A concrete 'ResourceProvider' that gets it's resources from the filesystem----{-# LANGUAGE CPP #-}-module Hakyll.Core.Resource.Provider.File- ( fileResourceProvider- ) where--import Control.Applicative ((<$>))--import Data.Time (readTime)-import System.Directory (getModificationTime)-import System.Locale (defaultTimeLocale)-import System.Time (formatCalendarTime, toCalendarTime)-import qualified Data.ByteString.Lazy as LB--import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Util.File-import Hakyll.Core.Configuration---- | Create a filesystem-based 'ResourceProvider'----fileResourceProvider :: HakyllConfiguration -> IO ResourceProvider-fileResourceProvider configuration = do- -- Retrieve a list of paths- list <- map resource . filter (not . shouldIgnoreFile configuration) <$>- getRecursiveContents False "."- makeResourceProvider list (readFile . unResource)- (LB.readFile . unResource)- (mtime . unResource)- where- mtime r = do-#if MIN_VERSION_directory(1,2,0)- getModificationTime r-#else- ct <- toCalendarTime =<< getModificationTime r- let str = formatCalendarTime defaultTimeLocale "%s" ct- return $ readTime defaultTimeLocale "%s" str-#endif
src/Hakyll/Core/Routes.hs view
@@ -1,3 +1,4 @@+-------------------------------------------------------------------------------- -- | Once a target is compiled, the user usually wants to save it to the disk. -- This is where the 'Routes' type comes in; it determines where a certain -- target should be written.@@ -24,7 +25,6 @@ -- not appear in your site directory. -- -- * If an item matches multiple routes, the first rule will be chosen.--- {-# LANGUAGE Rank2Types #-} module Hakyll.Core.Routes ( Routes@@ -38,33 +38,44 @@ , composeRoutes ) where ++-------------------------------------------------------------------------------- import Data.Monoid (Monoid, mempty, mappend) import Control.Monad (mplus) import System.FilePath (replaceExtension) ++-------------------------------------------------------------------------------- import Hakyll.Core.Identifier import Hakyll.Core.Identifier.Pattern import Hakyll.Core.Util.String ++-------------------------------------------------------------------------------- -- | Type used for a route----newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath}+newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} ++-------------------------------------------------------------------------------- instance Monoid Routes where mempty = Routes $ const Nothing mappend (Routes f) (Routes g) = Routes $ \id' -> f id' `mplus` g id' ++-------------------------------------------------------------------------------- -- | Apply a route to an identifier----runRoutes :: Routes -> Identifier a -> Maybe FilePath+runRoutes :: Routes -> Identifier -> Maybe FilePath runRoutes = unRoutes ++-------------------------------------------------------------------------------- -- | A route that uses the identifier as filepath. For example, the target with -- ID @foo\/bar@ will be written to the file @foo\/bar@.--- idRoute :: Routes idRoute = Routes $ Just . toFilePath ++-------------------------------------------------------------------------------- -- | Set (or replace) the extension of a route. -- -- Example:@@ -82,29 +93,34 @@ -- Result: -- -- > Just "posts/the-art-of-trolling.html"--- setExtension :: String -> Routes-setExtension extension = Routes $ fmap (`replaceExtension` extension)- . unRoutes idRoute+setExtension extension = Routes $+ fmap (`replaceExtension` extension) . unRoutes idRoute ++-------------------------------------------------------------------------------- -- | Apply the route if the identifier matches the given pattern, fail -- otherwise----matchRoute :: Pattern a -> Routes -> Routes+matchRoute :: Pattern -> Routes -> Routes matchRoute pattern (Routes route) = Routes $ \id' ->- if matches pattern (castIdentifier id') then route id' else Nothing+ if matches pattern id' then route id' else Nothing ++-------------------------------------------------------------------------------- -- | Create a custom route. This should almost always be used with -- 'matchRoute'----customRoute :: (Identifier a -> FilePath) -> Routes-customRoute f = Routes $ Just . f . castIdentifier+customRoute :: (Identifier -> FilePath) -> Routes+customRoute f = Routes $ Just . f ++-------------------------------------------------------------------------------- -- | A route that always gives the same result. Obviously, you should only use -- this for a single compilation rule. constRoute :: FilePath -> Routes constRoute = customRoute . const ++-------------------------------------------------------------------------------- -- | Create a gsub route -- -- Example:@@ -114,15 +130,16 @@ -- Result: -- -- > Just "tags/bar.xml"--- gsubRoute :: String -- ^ Pattern -> (String -> String) -- ^ Replacement -> Routes -- ^ Resulting route gsubRoute pattern replacement = customRoute $ replaceAll pattern replacement . toFilePath --- | Compose routes so that @f `composeRoutes` g@ is more or less equivalent--- with @f >>> g@.++--------------------------------------------------------------------------------+-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent+-- with @g . f@. -- -- Example: --@@ -134,10 +151,9 @@ -- > Just "tags/bar.xml" -- -- If the first route given fails, Hakyll will not apply the second route.--- composeRoutes :: Routes -- ^ First route to apply -> Routes -- ^ Second route to apply -> Routes -- ^ Resulting route composeRoutes (Routes f) (Routes g) = Routes $ \i -> do p <- f i- g $ parseIdentifier p+ g $ fromFilePath p
src/Hakyll/Core/Rules.hs view
@@ -1,7 +1,8 @@+-------------------------------------------------------------------------------- -- | This module provides a declarative DSL in which the user can specify the -- different rules used to run the compilers. ----- The convention is to just list all items in the 'RulesM' monad, routes and+-- The convention is to just list all items in the 'Rules' monad, routes and -- compilation rules. -- -- A typical usage example would be:@@ -13,238 +14,170 @@ -- > match "css/*" $ do -- > route idRoute -- > compile compressCssCompiler----{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Rules- ( RulesM- , Rules+ ( Rules , match- , group- , compile , create+ , version+ , compile , route- , resources- , metaCompile- , metaCompileWith- , freshIdentifier++ -- * Advanced usage+ , preprocess+ , Dependency (..)+ , rulesExtraDependencies ) where -import Control.Applicative ((<$>))-import Control.Monad.Writer (tell)-import Control.Monad.Reader (ask, local)-import Control.Arrow ((>>>), arr, (>>^), (***))-import Control.Monad.State (get, put)-import Data.Monoid (mempty, mappend)-import qualified Data.Set as S -import Data.Typeable (Typeable)-import Data.Binary (Binary)+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Monad.Reader (ask, local)+import Control.Monad.State (get, modify, put)+import Control.Monad.Trans (liftIO)+import Control.Monad.Writer (censor, tell)+import Data.Maybe (fromMaybe)+import Data.Monoid (mempty)+import qualified Data.Set as S -import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Routes-import Hakyll.Core.CompiledItem-import Hakyll.Core.Writable-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Util.Arrow +--------------------------------------------------------------------------------+import Data.Binary (Binary)+import Data.Typeable (Typeable)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Item+import Hakyll.Core.Item.SomeItem+import Hakyll.Core.Metadata+import Hakyll.Core.Routes+import Hakyll.Core.Rules.Internal+import Hakyll.Core.Writable+++-------------------------------------------------------------------------------- -- | Add a route----tellRoute :: Routes -> Rules-tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty+tellRoute :: Routes -> Rules ()+tellRoute route' = Rules $ tell $ RuleSet route' mempty mempty ++-------------------------------------------------------------------------------- -- | Add a number of compilers----tellCompilers :: (Binary a, Typeable a, Writable a)- => [(Identifier a, Compiler () a)]- -> Rules-tellCompilers compilers = RulesM $ do- -- We box the compilers so they have a more simple type- let compilers' = map (castIdentifier *** boxCompiler) compilers- tell $ RuleSet mempty compilers' mempty- where- boxCompiler = (>>> arr compiledItem >>> arr CompileRule)+tellCompilers :: [(Identifier, Compiler SomeItem)] -> Rules ()+tellCompilers compilers = Rules $ tell $ RuleSet mempty compilers mempty ++-------------------------------------------------------------------------------- -- | Add resources----tellResources :: [Resource]- -> Rules-tellResources resources' = RulesM $ tell $+tellResources :: [Identifier] -> Rules ()+tellResources resources' = Rules $ tell $ RuleSet mempty mempty $ S.fromList resources' --- | Only compile/route items satisfying the given predicate----match :: Pattern a -> RulesM b -> RulesM b-match pattern = RulesM . local addPredicate . unRulesM++--------------------------------------------------------------------------------+flush :: Rules ()+flush = Rules $ do+ mcompiler <- rulesCompiler <$> get+ case mcompiler of+ Nothing -> return ()+ Just compiler -> do+ matches' <- rulesMatches <$> ask+ version' <- rulesVersion <$> ask+ route' <- fromMaybe mempty . rulesRoute <$> get++ -- The version is possibly not set correctly at this point (yet)+ let ids = map (setVersion version') matches'++ {-+ ids <- case fromLiteral pattern of+ Just id' -> return [setVersion version' id']+ Nothing -> do+ ids <- unRules $ getMatches pattern+ unRules $ tellResources ids+ return $ map (setVersion version') ids+ -}++ -- Create a fast pattern for routing that matches exactly the+ -- compilers created in the block given to match+ let fastPattern = fromList ids++ -- Write out the compilers and routes+ unRules $ tellRoute $ matchRoute fastPattern route'+ unRules $ tellCompilers $ [(id', compiler) | id' <- ids]++ put $ emptyRulesState+++--------------------------------------------------------------------------------+match :: Pattern -> Rules () -> Rules ()+match pattern rules = do+ flush+ ids <- getMatches pattern+ tellResources ids+ Rules $ local (setMatches ids) $ unRules $ rules >> flush where- addPredicate env = env- { rulesPattern = rulesPattern env `mappend` castPattern pattern- }+ setMatches ids env = env {rulesMatches = ids} --- | Greate a group of compilers------ Imagine you have a page that you want to render, but you also want the raw--- content available on your site.------ > match "test.markdown" $ do--- > route $ setExtension "html"--- > compile pageCompiler--- >--- > match "test.markdown" $ do--- > route idRoute--- > compile copyPageCompiler------ Will of course conflict! In this case, Hakyll will pick the first matching--- compiler (@pageCompiler@ in this case).------ In case you want to have them both, you can use the 'group' function to--- create a new group. For example,------ > match "test.markdown" $ do--- > route $ setExtension "html"--- > compile pageCompiler--- >--- > group "raw" $ do--- > match "test.markdown" $ do--- > route idRoute--- > compile copyPageCompiler------ This will put the compiler for the raw content in a separate group--- (@\"raw\"@), which causes it to be compiled as well.----group :: String -> RulesM a -> RulesM a-group g = RulesM . local setGroup' . unRulesM++--------------------------------------------------------------------------------+create :: [Identifier] -> Rules () -> Rules ()+create ids rules = do+ flush+ -- TODO Maybe check if the resources exist and call tellResources on that+ Rules $ local setMatches $ unRules $ rules >> flush where- setGroup' env = env { rulesGroup = Just g }+ setMatches env = env {rulesMatches = ids} ++--------------------------------------------------------------------------------+version :: String -> Rules () -> Rules ()+version v rules = do+ flush+ Rules $ local setVersion' $ unRules $ rules >> flush+ where+ setVersion' env = env {rulesVersion = Just v}+++-------------------------------------------------------------------------------- -- | Add a compilation rule to the rules. ----- This instructs all resources to be compiled using the given compiler. When--- no resources match the current selection, nothing will happen. In this case,--- you might want to have a look at 'create'.----compile :: (Binary a, Typeable a, Writable a)- => Compiler Resource a -> RulesM (Pattern a)-compile compiler = do- ids <- resources- tellCompilers $ flip map ids $ \identifier ->- (identifier, constA (fromIdentifier identifier) >>> compiler)- tellResources $ map fromIdentifier ids- return $ list ids- --- | Add a compilation rule------ This sets a compiler for the given identifier. No resource is needed, since--- we are creating the item from scratch. This is useful if you want to create a--- page on your site that just takes content from other items -- but has no--- actual content itself. Note that the group of the given identifier is--- replaced by the group set via 'group' (or 'Nothing', if 'group' has not been--- used).----create :: (Binary a, Typeable a, Writable a)- => Identifier a -> Compiler () a -> RulesM (Identifier a)-create id' compiler = RulesM $ do- group' <- rulesGroup <$> ask- let id'' = setGroup group' id'- unRulesM $ tellCompilers [(id'', compiler)]- return id''+-- This instructs all resources to be compiled using the given compiler.+compile :: (Binary a, Typeable a, Writable a) => Compiler (Item a) -> Rules ()+compile compiler = Rules $ modify $ \s ->+ s {rulesCompiler = Just (fmap SomeItem compiler)} ++-------------------------------------------------------------------------------- -- | Add a route. -- -- This adds a route for all items matching the current pattern.----route :: Routes -> Rules-route route' = RulesM $ do- -- We want the route only to be applied if we match the current pattern and- -- group- pattern <- rulesPattern <$> ask- group' <- rulesGroup <$> ask- unRulesM $ tellRoute $ matchRoute (pattern `mappend` inGroup group') route'+route :: Routes -> Rules ()+route route' = Rules $ modify $ \s -> s {rulesRoute = Just route'} --- | Get a list of resources matching the current pattern. This will also set--- the correct group to the identifiers.----resources :: RulesM [Identifier a]-resources = RulesM $ do- pattern <- rulesPattern <$> ask- provider <- rulesResourceProvider <$> ask- group' <- rulesGroup <$> ask- -- Important: filter with pattern *before* setting the group- return $ map (setGroup group') $ filterMatches pattern $- map toIdentifier $ resourceList provider --- | Apart from regular compilers, one is also able to specify metacompilers.--- Metacompilers are a special class of compilers: they are compilers which--- produce other compilers.------ This is needed when the list of compilers depends on something we cannot know--- before actually running other compilers. The most typical example is if we--- have a blogpost using tags.------ Every post has a collection of tags. For example,------ > post1: code, haskell--- > post2: code, random------ Now, we want to create a list of posts for every tag. We cannot write this--- down in our 'Rules' DSL directly, since we don't know what tags the different--- posts will have -- we depend on information that will only be available when--- we are actually compiling the pages.------ The solution is simple, using 'metaCompile', we can add a compiler that will--- parse the pages and produce the compilers needed for the different tag pages.------ And indeed, we can see that the first argument to 'metaCompile' is a--- 'Compiler' which produces a list of ('Identifier', 'Compiler') pairs. The--- idea is simple: 'metaCompile' produces a list of compilers, and the--- corresponding identifiers.------ For simple hakyll systems, it is no need for this construction. More--- formally, it is only needed when the content of one or more items determines--- which items must be rendered.----metaCompile :: (Binary a, Typeable a, Writable a)- => Compiler () [(Identifier a, Compiler () a)] - -- ^ Compiler generating the other compilers- -> Rules- -- ^ Resulting rules-metaCompile compiler = do- id' <- freshIdentifier "Hakyll.Core.Rules.metaCompile"- metaCompileWith id' compiler+--------------------------------------------------------------------------------+-- | Execute an 'IO' action immediately while the rules are being evaluated.+-- This should be avoided if possible, but occasionally comes in useful.+preprocess :: IO a -> Rules a+preprocess = Rules . liftIO --- | Version of 'metaCompile' that allows you to specify a custom identifier for--- the metacompiler.----metaCompileWith :: (Binary a, Typeable a, Writable a)- => Identifier ()- -- ^ Identifier for this compiler- -> Compiler () [(Identifier a, Compiler () a)] - -- ^ Compiler generating the other compilers- -> Rules- -- ^ Resulting rules-metaCompileWith identifier compiler = RulesM $ do- group' <- rulesGroup <$> ask - let -- Set the correct group on the identifier- id' = setGroup group' identifier- -- Function to box an item into a rule- makeRule = MetaCompileRule . map (castIdentifier *** box)- -- Entire boxing function- box = (>>> fromDependency id' >>^ CompileRule . compiledItem)- -- Resulting compiler list- compilers = [(id', compiler >>> arr makeRule )]-- tell $ RuleSet mempty compilers mempty---- | Generate a fresh Identifier with a given prefix-freshIdentifier :: String -- ^ Prefix- -> RulesM (Identifier a) -- ^ Fresh identifier-freshIdentifier prefix = RulesM $ do- state <- get- let index = rulesNextIdentifier state- id' = parseIdentifier $ prefix ++ "/" ++ show index- put $ state {rulesNextIdentifier = index + 1}- return id'+--------------------------------------------------------------------------------+-- | Advanced usage: add extra dependencies to compilers. Basically this is+-- needed when you're doing unsafe tricky stuff in the rules monad, but you+-- still want correct builds.+rulesExtraDependencies :: [Dependency] -> Rules a -> Rules a+rulesExtraDependencies deps = Rules . censor addDependencies . unRules+ where+ -- Adds the dependencies to the compilers in the ruleset+ addDependencies ruleSet = ruleSet+ { rulesCompilers =+ [ (i, compilerTellDependencies deps >> c)+ | (i, c) <- rulesCompilers ruleSet+ ]+ }
src/Hakyll/Core/Rules/Internal.hs view
@@ -1,99 +1,110 @@--- | Internal rules module for types which are not exposed to the user----{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}+--------------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Rank2Types #-} module Hakyll.Core.Rules.Internal- ( CompileRule (..)+ ( RulesRead (..) , RuleSet (..)- , RuleState (..)- , RuleEnvironment (..)- , RulesM (..)- , Rules+ , RulesState (..)+ , emptyRulesState+ , Rules (..) , runRules ) where -import Control.Applicative (Applicative)-import Control.Monad.Writer (WriterT, execWriterT)-import Control.Monad.Reader (ReaderT, runReaderT)-import Control.Monad.State (State, evalState)-import Data.Monoid (Monoid, mempty, mappend)-import Data.Set (Set)-import qualified Data.Map as M -import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Routes-import Hakyll.Core.CompiledItem+--------------------------------------------------------------------------------+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) --- | Output of a compiler rule------ * The compiler will produce a simple item. This is the most common case.------ * The compiler will produce more compilers. These new compilers need to be--- added to the runtime if possible, since other items might depend upon them.----data CompileRule = CompileRule CompiledItem- | MetaCompileRule [(Identifier (), Compiler () CompileRule)] --- | A collection of rules for the compilation process---+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Item.SomeItem+import Hakyll.Core.Metadata+import Hakyll.Core.Provider+import Hakyll.Core.Routes+++--------------------------------------------------------------------------------+data RulesRead = RulesRead+ { rulesProvider :: Provider+ , rulesMatches :: [Identifier]+ , rulesVersion :: Maybe String+ }+++-------------------------------------------------------------------------------- data RuleSet = RuleSet- { -- | Routes used in the compilation structure+ { -- | Accumulated routes rulesRoutes :: Routes- , -- | Compilation rules- rulesCompilers :: [(Identifier (), Compiler () CompileRule)]- , -- | A list of the used resources- rulesResources :: Set Resource+ , -- | Accumulated compilers+ rulesCompilers :: [(Identifier, Compiler SomeItem)]+ , -- | A set of the actually used files+ rulesResources :: Set Identifier } ++-------------------------------------------------------------------------------- instance Monoid RuleSet where mempty = RuleSet mempty mempty mempty mappend (RuleSet r1 c1 s1) (RuleSet r2 c2 s2) = RuleSet (mappend r1 r2) (mappend c1 c2) (mappend s1 s2) --- | Rule state----data RuleState = RuleState- { rulesNextIdentifier :: Int- } deriving (Show) --- | Rule environment----data RuleEnvironment = RuleEnvironment- { rulesResourceProvider :: ResourceProvider- , rulesPattern :: forall a. Pattern a- , rulesGroup :: Maybe String+--------------------------------------------------------------------------------+data RulesState = RulesState+ { rulesRoute :: Maybe Routes+ , rulesCompiler :: Maybe (Compiler SomeItem) } ++--------------------------------------------------------------------------------+emptyRulesState :: RulesState+emptyRulesState = RulesState Nothing Nothing+++-------------------------------------------------------------------------------- -- | The monad used to compose rules----newtype RulesM a = RulesM- { unRulesM :: ReaderT RuleEnvironment (WriterT RuleSet (State RuleState)) a+newtype Rules a = Rules+ { unRules :: RWST RulesRead RuleSet RulesState IO a } deriving (Monad, Functor, Applicative) --- | Simplification of the RulesM type; usually, it will not return any--- result.----type Rules = RulesM () +--------------------------------------------------------------------------------+instance MonadMetadata Rules where+ getMetadata identifier = Rules $ do+ provider <- rulesProvider <$> ask+ liftIO $ resourceMetadata provider identifier++ getMatches pattern = Rules $ do+ provider <- rulesProvider <$> ask+ return $ filterMatches pattern $ resourceList provider+++-------------------------------------------------------------------------------- -- | Run a Rules monad, resulting in a 'RuleSet'----runRules :: RulesM a -> ResourceProvider -> RuleSet-runRules rules provider = nubCompilers $- evalState (execWriterT $ runReaderT (unRulesM rules) env) state+runRules :: Rules a -> Provider -> IO RuleSet+runRules rules provider = do+ (_, _, ruleSet) <- runRWST (unRules rules) env emptyRulesState+ return $ nubCompilers ruleSet where- state = RuleState {rulesNextIdentifier = 0}- env = RuleEnvironment { rulesResourceProvider = provider- , rulesPattern = mempty- , rulesGroup = Nothing- }+ env = RulesRead+ { rulesProvider = provider+ , rulesMatches = []+ , rulesVersion = Nothing+ } ++-------------------------------------------------------------------------------- -- | Remove duplicate compilers from the 'RuleSet'. When two compilers match an -- item, we prefer the first one--- nubCompilers :: RuleSet -> RuleSet-nubCompilers set = set { rulesCompilers = nubCompilers' (rulesCompilers set) }+nubCompilers set = set {rulesCompilers = nubCompilers' (rulesCompilers set)} where nubCompilers' = M.toList . M.fromListWith (flip const)
− src/Hakyll/Core/Run.hs
@@ -1,217 +0,0 @@--- | This is the module which binds it all together----{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}-module Hakyll.Core.Run- ( run- ) where--import Control.Applicative (Applicative, (<$>))-import Control.Monad (filterM, forM_)-import Control.Monad.Error (ErrorT, runErrorT, throwError)-import Control.Monad.Reader (ReaderT, runReaderT, ask)-import Control.Monad.State.Strict (StateT, runStateT, get, put)-import Control.Monad.Trans (liftIO)-import Data.Map (Map)-import Data.Monoid (mempty, mappend)-import Prelude hiding (reverse)-import System.Exit (ExitCode (..), exitWith)-import System.FilePath ((</>))-import qualified Data.Map as M-import qualified Data.Set as S--import Hakyll.Core.Compiler-import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Configuration-import Hakyll.Core.DependencyAnalyzer-import Hakyll.Core.DirectedGraph-import Hakyll.Core.Identifier-import Hakyll.Core.Logger-import Hakyll.Core.Resource-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Resource.Provider.File-import Hakyll.Core.Routes-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Store (Store)-import Hakyll.Core.Util.File-import Hakyll.Core.Writable-import qualified Hakyll.Core.Store as Store---- | Run all rules needed, return the rule set used----run :: HakyllConfiguration -> RulesM a -> IO RuleSet-run configuration rules = do- logger <- makeLogger putStrLn-- section logger "Initialising"- store <- timed logger "Creating store" $- Store.new (inMemoryCache configuration) $ storeDirectory configuration- provider <- timed logger "Creating provider" $- fileResourceProvider configuration-- -- Fetch the old graph from the store. If we don't find it, we consider this- -- to be the first run- graph <- Store.get store ["Hakyll.Core.Run.run", "dependencies"]- let (firstRun, oldGraph) = case graph of Store.Found g -> (False, g)- _ -> (True, mempty)-- let ruleSet = runRules rules provider- compilers = rulesCompilers ruleSet-- -- Extract the reader/state- reader = unRuntime $ addNewCompilers compilers- stateT = runReaderT reader $ RuntimeEnvironment- { hakyllLogger = logger- , hakyllConfiguration = configuration- , hakyllRoutes = rulesRoutes ruleSet- , hakyllResourceProvider = provider- , hakyllStore = store- , hakyllFirstRun = firstRun- }-- -- Run the program and fetch the resulting state- result <- runErrorT $ runStateT stateT $ RuntimeState- { hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph- , hakyllCompilers = M.empty- }-- case result of- Left e -> do- thrown logger e- flushLogger logger- exitWith $ ExitFailure 1- Right ((), state') -> do- -- We want to save the final dependency graph for the next run- Store.set store ["Hakyll.Core.Run.run", "dependencies"] $- analyzerGraph $ hakyllAnalyzer state'- flushLogger logger- return ruleSet--data RuntimeEnvironment = RuntimeEnvironment- { hakyllLogger :: Logger- , hakyllConfiguration :: HakyllConfiguration- , hakyllRoutes :: Routes- , hakyllResourceProvider :: ResourceProvider- , hakyllStore :: Store- , hakyllFirstRun :: Bool- }--data RuntimeState = RuntimeState- { hakyllAnalyzer :: DependencyAnalyzer (Identifier ())- , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule)- }--newtype Runtime a = Runtime- { unRuntime :: ReaderT RuntimeEnvironment- (StateT RuntimeState (ErrorT String IO)) a- } deriving (Functor, Applicative, Monad)---- | Add a number of compilers and continue using these compilers----addNewCompilers :: [(Identifier (), Compiler () CompileRule)]- -- ^ Compilers to add- -> Runtime ()-addNewCompilers newCompilers = Runtime $ do- -- Get some information- logger <- hakyllLogger <$> ask- section logger "Adding new compilers"- provider <- hakyllResourceProvider <$> ask- store <- hakyllStore <$> ask- firstRun <- hakyllFirstRun <$> ask-- -- Old state information- oldCompilers <- hakyllCompilers <$> get- oldAnalyzer <- hakyllAnalyzer <$> get-- let -- All known compilers- universe = M.keys oldCompilers ++ map fst newCompilers-- -- Create a new partial dependency graph- dependencies = flip map newCompilers $ \(id', compiler) ->- let deps = runCompilerDependencies compiler id' universe- in (id', deps)-- -- Create the dependency graph- newGraph = fromList dependencies-- -- Check which items have been modified- modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $- liftIO . resourceModified provider store . fromIdentifier- let checkModified = if firstRun then const True else (`S.member` modified)-- -- Create a new analyzer and append it to the currect one- let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $- analyzerPreviousGraph oldAnalyzer- analyzer = mappend oldAnalyzer newAnalyzer-- -- Update the state- put $ RuntimeState- { hakyllAnalyzer = analyzer- , hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)- }-- -- Continue- unRuntime stepAnalyzer--stepAnalyzer :: Runtime ()-stepAnalyzer = Runtime $ do- -- Step the analyzer- state <- get- let (signal, analyzer') = step $ hakyllAnalyzer state- put $ state { hakyllAnalyzer = analyzer' }-- case signal of Done -> return ()- Cycle c -> unRuntime $ dumpCycle c- Build id' -> unRuntime $ build id'---- | Dump cyclic error and quit----dumpCycle :: [Identifier ()] -> Runtime ()-dumpCycle cycle' = Runtime $ do- logger <- hakyllLogger <$> ask- section logger "Dependency cycle detected! Conflict:"- forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->- report logger $ show x ++ " -> " ++ show y--build :: Identifier () -> Runtime ()-build id' = Runtime $ do- logger <- hakyllLogger <$> ask- routes <- hakyllRoutes <$> ask- provider <- hakyllResourceProvider <$> ask- store <- hakyllStore <$> ask- compilers <- hakyllCompilers <$> get-- section logger $ "Compiling " ++ show id'-- -- Fetch the right compiler from the map- let compiler = compilers M.! id'-- -- Check if the resource was modified- isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'-- -- Run the compiler- result <- timed logger "Total compile time" $ liftIO $- runCompiler compiler id' provider (M.keys compilers) routes- store isModified logger-- case result of- -- Compile rule for one item, easy stuff- Right (CompileRule compiled) -> do- case runRoutes routes id' of- Nothing -> return ()- Just url -> timed logger ("Routing to " ++ url) $ do- destination <-- destinationDirectory . hakyllConfiguration <$> ask- let path = destination </> url- liftIO $ makeDirectories path- liftIO $ write path compiled-- -- Continue for the remaining compilers- unRuntime stepAnalyzer-- -- Metacompiler, slightly more complicated- Right (MetaCompileRule newCompilers) ->- -- Actually I was just kidding, it's not hard at all- unRuntime $ addNewCompilers newCompilers-- -- Some error happened, rethrow in Runtime monad- Left err -> throwError err
+ src/Hakyll/Core/Runtime.hs view
@@ -0,0 +1,250 @@+--------------------------------------------------------------------------------+module Hakyll.Core.Runtime+ ( run+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Monad (filterM, unless)+import Control.Monad.Error (ErrorT, runErrorT, throwError)+import Control.Monad.Reader (ask)+import Control.Monad.RWS (RWST, runRWST)+import Control.Monad.State (get, modify)+import Control.Monad.Trans (liftIO)+import Data.Map (Map)+import qualified Data.Map as M+import Data.Monoid (mempty)+import Data.Set (Set)+import qualified Data.Set as S+import System.Exit (ExitCode (..))+import System.FilePath ((</>))+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Compiler.Require+import Hakyll.Core.Configuration+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Core.Item.SomeItem+import Hakyll.Core.Logger (Logger, Verbosity)+import qualified Hakyll.Core.Logger as Logger+import Hakyll.Core.Provider+import Hakyll.Core.Routes+import Hakyll.Core.Rules.Internal+import Hakyll.Core.Store (Store)+import qualified Hakyll.Core.Store as Store+import Hakyll.Core.Util.File+import Hakyll.Core.Writable+++--------------------------------------------------------------------------------+run :: Configuration -> Verbosity -> Rules a -> IO (ExitCode, RuleSet)+run config verbosity rules = do+ -- Initialization+ logger <- Logger.new verbosity+ Logger.header logger "Initialising..."+ Logger.message logger "Creating store..."+ store <- Store.new (inMemoryCache config) $ storeDirectory config+ Logger.message logger "Creating provider..."+ provider <- newProvider store (shouldIgnoreFile config) $+ providerDirectory config+ Logger.message logger "Running rules..."+ ruleSet <- runRules rules provider++ -- Get old facts+ mOldFacts <- Store.get store factsKey+ let (oldFacts) = case mOldFacts of Store.Found f -> f+ _ -> mempty++ -- Build runtime read/state+ let compilers = rulesCompilers ruleSet+ read' = RuntimeRead+ { runtimeConfiguration = config+ , runtimeLogger = logger+ , runtimeProvider = provider+ , runtimeStore = store+ , runtimeRoutes = rulesRoutes ruleSet+ , runtimeUniverse = M.fromList compilers+ }+ state = RuntimeState+ { runtimeDone = S.empty+ , runtimeTodo = M.empty+ , runtimeFacts = oldFacts+ }++ -- Run the program and fetch the resulting state+ result <- runErrorT $ runRWST build read' state+ case result of+ Left e -> do+ Logger.error logger e+ Logger.flush logger+ return (ExitFailure 1, ruleSet)++ Right (_, s, _) -> do+ Store.set store factsKey $ runtimeFacts s++ Logger.debug logger "Removing tmp directory..."+ removeDirectory $ tmpDirectory config++ Logger.flush logger+ return (ExitSuccess, ruleSet)+ where+ factsKey = ["Hakyll.Core.Runtime.run", "facts"]+++--------------------------------------------------------------------------------+data RuntimeRead = RuntimeRead+ { runtimeConfiguration :: Configuration+ , runtimeLogger :: Logger+ , runtimeProvider :: Provider+ , runtimeStore :: Store+ , runtimeRoutes :: Routes+ , runtimeUniverse :: Map Identifier (Compiler SomeItem)+ }+++--------------------------------------------------------------------------------+data RuntimeState = RuntimeState+ { runtimeDone :: Set Identifier+ , runtimeTodo :: Map Identifier (Compiler SomeItem)+ , runtimeFacts :: DependencyFacts+ }+++--------------------------------------------------------------------------------+type Runtime a = RWST RuntimeRead () RuntimeState (ErrorT String IO) a+++--------------------------------------------------------------------------------+build :: Runtime ()+build = do+ logger <- runtimeLogger <$> ask+ Logger.header logger "Checking for out-of-date items"+ scheduleOutOfDate+ Logger.header logger "Compiling"+ pickAndChase+ Logger.header logger "Success"+++--------------------------------------------------------------------------------+scheduleOutOfDate :: Runtime ()+scheduleOutOfDate = do+ logger <- runtimeLogger <$> ask+ provider <- runtimeProvider <$> ask+ universe <- runtimeUniverse <$> ask+ facts <- runtimeFacts <$> get+ todo <- runtimeTodo <$> get++ let identifiers = M.keys universe+ modified <- fmap S.fromList $ flip filterM identifiers $+ liftIO . resourceModified provider+ let (ood, facts', msgs) = outOfDate identifiers modified facts+ todo' = M.filterWithKey+ (\id' _ -> id' `S.member` ood) universe++ -- Print messages+ mapM_ (Logger.debug logger) msgs++ -- Update facts and todo items+ modify $ \s -> s+ { runtimeDone = runtimeDone s `S.union`+ (S.fromList identifiers `S.difference` ood)+ , runtimeTodo = todo `M.union` todo'+ , runtimeFacts = facts'+ }+++--------------------------------------------------------------------------------+pickAndChase :: Runtime ()+pickAndChase = do+ todo <- runtimeTodo <$> get+ case M.minViewWithKey todo of+ Nothing -> return ()+ Just ((id', _), _) -> do+ chase [] id'+ pickAndChase+++--------------------------------------------------------------------------------+chase :: [Identifier] -> Identifier -> Runtime ()+chase trail id'+ | id' `elem` trail = return () -- Cycle detected!+ | otherwise = do+ logger <- runtimeLogger <$> ask+ todo <- runtimeTodo <$> get+ provider <- runtimeProvider <$> ask+ universe <- runtimeUniverse <$> ask+ routes <- runtimeRoutes <$> ask+ store <- runtimeStore <$> ask+ config <- runtimeConfiguration <$> ask+ Logger.debug logger $ "Processing " ++ show id'++ let compiler = todo M.! id'+ read' = CompilerRead+ { compilerConfig = config+ , compilerUnderlying = id'+ , compilerProvider = provider+ , compilerUniverse = M.keysSet universe+ , compilerRoutes = routes+ , compilerStore = store+ , compilerLogger = logger+ }++ result <- liftIO $ runCompiler compiler read'+ case result of+ -- Rethrow error+ CompilerError e -> throwError e++ -- Huge success+ CompilerDone (SomeItem item) cwrite -> do+ -- Print some info+ let facts = compilerDependencies cwrite+ cacheHits+ | compilerCacheHits cwrite <= 0 = "updated"+ | otherwise = "cached "+ Logger.message logger $ cacheHits ++ " " ++ show id'++ -- Sanity check+ unless (itemIdentifier item == id') $ throwError $+ "The compiler yielded an Item with Identifier " +++ show (itemIdentifier item) ++ ", but we were expecting " +++ "an Item with Identifier " ++ show id' ++ " " +++ "(you probably want to call makeItem to solve this problem)"++ -- Write if necessary+ case runRoutes routes id' of+ Nothing -> return ()+ Just url -> do+ let path = destinationDirectory config </> url+ liftIO $ makeDirectories path+ liftIO $ write path item+ Logger.debug logger $ "Routed to " ++ path++ -- Save! (For load)+ liftIO $ save store item++ -- Update state+ modify $ \s -> s+ { runtimeDone = S.insert id' (runtimeDone s)+ , runtimeTodo = M.delete id' (runtimeTodo s)+ , runtimeFacts = M.insert id' facts (runtimeFacts s)+ }++ -- Try something else first+ CompilerRequire dep c -> do+ -- Update the compiler so we don't execute it twice+ depDone <- (dep `S.member`) . runtimeDone <$> get+ modify $ \s -> s+ { runtimeTodo = M.insert id'+ (if depDone then c else compilerResult result)+ (runtimeTodo s)+ }++ -- If the required item is already compiled, continue, or, start+ -- chasing that+ Logger.debug logger $ "Require " ++ show dep ++ ": " +++ (if depDone then "OK" else "chasing")+ if depDone then chase trail id' else chase (id' : trail) dep
src/Hakyll/Core/Store.hs view
@@ -9,6 +9,7 @@ , set , get , delete+ , hash ) where @@ -144,12 +145,13 @@ ---------------------------------------------------------------------------------hash :: [String] -> String-hash = concatMap (printf "%02x") . B.unpack .- MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"----------------------------------------------------------------------------------- -- | Delete a file unless it doesn't exist... deleteFile :: FilePath -> IO () deleteFile = handle (\(_ :: IOException) -> return ()) . removeFile+++--------------------------------------------------------------------------------+-- | Mostly meant for internal usage+hash :: [String] -> String+hash = concatMap (printf "%02x") . B.unpack .+ MD5.hash . T.encodeUtf8 . T.pack . intercalate "/"
src/Hakyll/Core/UnixFilter.hs view
@@ -1,26 +1,30 @@+-------------------------------------------------------------------------------- -- | A Compiler that supports unix filters.--- module Hakyll.Core.UnixFilter ( unixFilter , unixFilterLBS ) where -import Control.Concurrent (forkIO)-import System.Process-import System.IO ( Handle, hPutStr, hClose, hGetContents- , hSetEncoding, localeEncoding- ) -import Data.ByteString.Lazy (ByteString)+--------------------------------------------------------------------------------+import Control.Concurrent (forkIO)+import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as LB+import System.IO (Handle, hClose, hGetContents, hPutStr,+ hSetEncoding, localeEncoding)+import System.Process -import Hakyll.Core.Compiler +--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+++-------------------------------------------------------------------------------- -- | Use a unix filter as compiler. For example, we could use the 'rev' program -- as a compiler. ----- > rev :: Compiler Resource String--- > rev = getResourceString >>> unixFilter "rev" []+-- > rev :: Compiler String+-- > rev = getResourceString >>= withItemBody (unixFilter "rev" []) -- -- A more realistic example: one can use this to call, for example, the sass -- compiler on CSS files. More information about sass can be found here:@@ -31,12 +35,13 @@ -- -- > match "style.scss" $ do -- > route $ setExtension "css"--- > compile $ getResourceString >>> unixFilter "sass" ["-s", "--scss"]--- > >>> arr compressCss----unixFilter :: String -- ^ Program name- -> [String] -- ^ Program args- -> Compiler String String -- ^ Resulting compiler+-- > compile $ getResourceString >>=+-- > withItemBody (unixFilter "sass" ["-s", "--scss"]) >>=+-- > return . fmap compressCss+unixFilter :: String -- ^ Program name+ -> [String] -- ^ Program args+ -> String -- ^ Program input+ -> Compiler String -- ^ Program output unixFilter = unixFilterWith writer reader where writer handle input = do@@ -46,30 +51,35 @@ hSetEncoding handle localeEncoding hGetContents handle ++-------------------------------------------------------------------------------- -- | Variant of 'unixFilter' that should be used for binary files -- -- > match "music.wav" $ do -- > route $ setExtension "ogg"--- > compile $ getResourceLBS >>> unixFilter "oggenc" ["-"]----unixFilterLBS :: String -- ^ Program name- -> [String] -- ^ Program args- -> Compiler ByteString ByteString -- ^ Resulting compiler+-- > compile $ getResourceLBS >>= withItemBody (unixFilter "oggenc" ["-"])+unixFilterLBS :: String -- ^ Program name+ -> [String] -- ^ Program args+ -> ByteString -- ^ Program input+ -> Compiler ByteString -- ^ Program output unixFilterLBS = unixFilterWith LB.hPutStr LB.hGetContents ++-------------------------------------------------------------------------------- -- | Overloaded compiler--- unixFilterWith :: (Handle -> i -> IO ()) -- ^ Writer -> (Handle -> IO o) -- ^ Reader -> String -- ^ Program name -> [String] -- ^ Program args- -> Compiler i o -- ^ Resulting compiler-unixFilterWith writer reader programName args =- timedCompiler ("Executing external program " ++ programName) $- unsafeCompiler $ unixFilterIO writer reader programName args+ -> i -- ^ Program input+ -> Compiler o -- ^ Program output+unixFilterWith writer reader programName args input = do+ debugCompiler ("Executing external program " ++ programName)+ unsafeCompiler $ unixFilterIO writer reader programName args input ++-------------------------------------------------------------------------------- -- | Internally used function--- unixFilterIO :: (Handle -> i -> IO ()) -> (Handle -> IO o) -> String@@ -78,10 +88,11 @@ -> IO o unixFilterIO writer reader programName args input = do let process = (proc programName args)- { std_in = CreatePipe- , std_out = CreatePipe- , close_fds = True- }+ { std_in = CreatePipe+ , std_out = CreatePipe+ , close_fds = True+ }+ (Just stdinWriteHandle, Just stdoutReadHandle, _, _) <- createProcess process
− src/Hakyll/Core/Util/Arrow.hs
@@ -1,25 +0,0 @@--- | Various arrow utility functions----module Hakyll.Core.Util.Arrow- ( constA- , sequenceA- , unitA- ) where--import Control.Arrow (Arrow, (&&&), arr, (>>^))--constA :: Arrow a- => c- -> a b c-constA = arr . const--sequenceA :: Arrow a- => [a b c]- -> a b [c]-sequenceA = foldr reduce $ constA []- where- reduce xa la = xa &&& la >>^ arr (uncurry (:))--unitA :: Arrow a- => a b ()-unitA = constA ()
src/Hakyll/Core/Util/File.hs view
@@ -1,61 +1,53 @@+-------------------------------------------------------------------------------- -- | A module containing various file utility functions--- module Hakyll.Core.Util.File ( makeDirectories , getRecursiveContents- , isFileInternal+ , removeDirectory ) where -import Control.Applicative ((<$>))-import Control.Monad (forM)-import Data.List (isPrefixOf)-import System.Directory ( createDirectoryIfMissing, doesDirectoryExist- , getDirectoryContents- )-import System.FilePath ( normalise, takeDirectory, splitPath- , dropTrailingPathSeparator, (</>)- ) -import Hakyll.Core.Configuration+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Monad (forM, when)+import System.Directory (createDirectoryIfMissing,+ doesDirectoryExist, getDirectoryContents,+ removeDirectoryRecursive)+import System.FilePath (takeDirectory, (</>)) ++-------------------------------------------------------------------------------- -- | Given a path to a file, try to make the path writable by making -- all directories on the path.--- makeDirectories :: FilePath -> IO () makeDirectories = createDirectoryIfMissing True . takeDirectory --- | Get all contents of a directory. Note that files starting with a dot (.)--- will be ignored.----getRecursiveContents :: Bool -- ^ Include directories?- -> FilePath -- ^ Directory to search++--------------------------------------------------------------------------------+-- | Get all contents of a directory.+getRecursiveContents :: FilePath -- ^ Directory to search -> IO [FilePath] -- ^ List of files found-getRecursiveContents includeDirs topdir = do- topdirExists <- doesDirectoryExist topdir- if not topdirExists- then return []- else do- names <- filter isProper <$> getDirectoryContents topdir- paths <- forM names $ \name -> do- let path = normalise $ topdir </> name- isDirectory <- doesDirectoryExist path- if isDirectory then getRecursiveContents includeDirs path- else return [path]- return $ if includeDirs then topdir : concat paths- else concat paths+getRecursiveContents top = go "" where isProper = (`notElem` [".", ".."])+ go dir = do+ dirExists <- doesDirectoryExist (top </> dir)+ if not dirExists+ then return []+ else do+ names <- filter isProper <$> getDirectoryContents (top </> dir)+ paths <- forM names $ \name -> do+ let rel = dir </> name+ isDirectory <- doesDirectoryExist (top </> rel)+ if isDirectory+ then go rel+ else return [rel] --- | Check if a file is meant for Hakyll internal use, i.e. if it is located in--- the destination or store directory----isFileInternal :: HakyllConfiguration -- ^ Configuration- -> FilePath -- ^ File to check- -> Bool -- ^ If the given file is internal-isFileInternal configuration file =- any (`isPrefixOf` split file) dirs- where- split = map dropTrailingPathSeparator . splitPath- dirs = map (split . ($ configuration)) [ destinationDirectory- , storeDirectory- ]+ return $ concat paths+++--------------------------------------------------------------------------------+removeDirectory :: FilePath -> IO ()+removeDirectory fp = do+ e <- doesDirectoryExist fp+ when e $ removeDirectoryRecursive fp
src/Hakyll/Core/Writable.hs view
@@ -1,42 +1,56 @@+-------------------------------------------------------------------------------- -- | Describes writable items; items that can be saved to the disk----{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-} module Hakyll.Core.Writable ( Writable (..) ) where -import Data.Word (Word8) -import qualified Data.ByteString as SB-import qualified Data.ByteString.Lazy as LB-import Text.Blaze.Html (Html)-import Text.Blaze.Html.Renderer.String (renderHtml)+--------------------------------------------------------------------------------+import qualified Data.ByteString as SB+import qualified Data.ByteString.Lazy as LB+import Data.Word (Word8)+import Text.Blaze.Html (Html)+import Text.Blaze.Html.Renderer.String (renderHtml) -import Hakyll.Core.Identifier +--------------------------------------------------------------------------------+import Hakyll.Core.Item+++-------------------------------------------------------------------------------- -- | Describes an item that can be saved to the disk--- class Writable a where -- | Save an item to the given filepath- write :: FilePath -> a -> IO ()+ write :: FilePath -> Item a -> IO () ++-------------------------------------------------------------------------------- instance Writable () where write _ _ = return () ++-------------------------------------------------------------------------------- instance Writable [Char] where- write = writeFile+ write p = writeFile p . itemBody ++-------------------------------------------------------------------------------- instance Writable SB.ByteString where- write p = SB.writeFile p+ write p = SB.writeFile p . itemBody ++-------------------------------------------------------------------------------- instance Writable LB.ByteString where- write p = LB.writeFile p+ write p = LB.writeFile p . itemBody ++-------------------------------------------------------------------------------- instance Writable [Word8] where- write p = write p . SB.pack+ write p = write p . fmap SB.pack -instance Writable Html where- write p html = write p $ renderHtml html -instance Writable (Identifier a) where- write p = write p . show+--------------------------------------------------------------------------------+instance Writable Html where+ write p = write p . fmap renderHtml
− src/Hakyll/Core/Writable/CopyFile.hs
@@ -1,29 +0,0 @@--- | Exports simple compilers to just copy files----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.Writable.CopyFile- ( CopyFile (..)- , copyFileCompiler- ) where--import Control.Arrow ((>>^))-import System.Directory (copyFile)--import Data.Typeable (Typeable)-import Data.Binary (Binary)--import Hakyll.Core.Resource-import Hakyll.Core.Writable-import Hakyll.Core.Compiler-import Hakyll.Core.Identifier---- | Newtype construct around 'FilePath' which will copy the file directly----newtype CopyFile = CopyFile {unCopyFile :: FilePath}- deriving (Show, Eq, Ord, Binary, Typeable)--instance Writable CopyFile where- write dst (CopyFile src) = copyFile src dst--copyFileCompiler :: Compiler Resource CopyFile-copyFileCompiler = getIdentifier >>^ CopyFile . toFilePath
− src/Hakyll/Core/Writable/WritableTuple.hs
@@ -1,37 +0,0 @@--- | This module exposes a writable type 'WritableTuple' which is a simple--- newtype wrapper around a tuple.------ The idea is that, given a tuple @(a, b)@, @a@ is the value you actually want--- to save to the disk, and @b@ is some additional info that you /don't/ want to--- save, but that you need later, for example in a 'require' clause.----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}-module Hakyll.Core.Writable.WritableTuple- ( WritableTuple (..)- , writableTupleFst- , writableTupleSnd- , writableTupleCompiler- ) where--import Control.Arrow (arr)--import Data.Typeable (Typeable)-import Data.Binary (Binary)--import Hakyll.Core.Writable-import Hakyll.Core.Compiler--newtype WritableTuple a b = WritableTuple {unWritableTuple :: (a, b)}- deriving (Show, Eq, Ord, Binary, Typeable)--instance Writable a => Writable (WritableTuple a b) where- write dst (WritableTuple (x, _)) = write dst x--writableTupleFst :: WritableTuple a b -> a-writableTupleFst = fst . unWritableTuple--writableTupleSnd :: WritableTuple a b -> b-writableTupleSnd = snd . unWritableTuple--writableTupleCompiler :: Compiler (a, b) (WritableTuple a b)-writableTupleCompiler = arr WritableTuple
+ src/Hakyll/Init.hs view
@@ -0,0 +1,37 @@+--------------------------------------------------------------------------------+module Main+ ( main+ ) where+++--------------------------------------------------------------------------------+import Control.Monad (forM_)+import System.Directory (copyFile)+import System.Environment (getArgs, getProgName)+import System.Exit (exitFailure)+import System.FilePath ((</>))+++--------------------------------------------------------------------------------+import Hakyll.Core.Util.File+import Paths_hakyll+++--------------------------------------------------------------------------------+main :: IO ()+main = do+ progName <- getProgName+ args <- getArgs+ srcDir <- getDataFileName "example"+ files <- getRecursiveContents srcDir++ case args of+ [dstDir] -> forM_ files $ \file -> do+ let dst = dstDir </> file+ src = srcDir </> file+ putStrLn $ "Creating " ++ dst+ makeDirectories dst+ copyFile src dst+ _ -> do+ putStrLn $ "Usage: " ++ progName ++ " <directory>"+ exitFailure
src/Hakyll/Main.hs view
@@ -1,153 +1,106 @@+-------------------------------------------------------------------------------- -- | Module providing the main hakyll function and command-line argument parsing----{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} module Hakyll.Main ( hakyll , hakyllWith ) where -import Control.Monad (when)-import System.Directory (doesDirectoryExist, removeDirectoryRecursive)-import System.Environment (getProgName, getArgs)-import System.Process (system) -import Hakyll.Core.Configuration-import Hakyll.Core.Run-import Hakyll.Core.Rules+--------------------------------------------------------------------------------+import System.Console.CmdArgs+import qualified System.Console.CmdArgs.Explicit as CA+import System.Environment (getProgName)+import System.IO.Unsafe (unsafePerformIO) -#ifdef PREVIEW_SERVER-import Control.Applicative ((<$>))-import Control.Concurrent (forkIO)-import qualified Data.Set as S -import Hakyll.Core.Resource-import Hakyll.Core.Rules.Internal-import Hakyll.Web.Preview.Poll-import Hakyll.Web.Preview.Server-#endif+--------------------------------------------------------------------------------+import qualified Hakyll.Check as Check+import qualified Hakyll.Commands as Commands+import qualified Hakyll.Core.Configuration as Config+import qualified Hakyll.Core.Logger as Logger+import Hakyll.Core.Rules ++-------------------------------------------------------------------------------- -- | This usualy is the function with which the user runs the hakyll compiler----hakyll :: RulesM a -> IO ()-hakyll = hakyllWith defaultHakyllConfiguration+hakyll :: Rules a -> IO ()+hakyll = hakyllWith Config.defaultConfiguration ++-------------------------------------------------------------------------------- -- | A variant of 'hakyll' which allows the user to specify a custom -- configuration----hakyllWith :: HakyllConfiguration -> RulesM a -> IO ()+hakyllWith :: Config.Configuration -> Rules a -> IO () hakyllWith conf rules = do- args <- getArgs- case args of- ["build"] -> build conf rules- ["clean"] -> clean conf- ["help"] -> help- ["preview"] -> preview conf rules 8000- ["preview", p] -> preview conf rules (read p)- ["rebuild"] -> rebuild conf rules- ["server"] -> server conf 8000- ["server", p] -> server conf (read p)- ["deploy"] -> deploy conf- _ -> help+ args' <- cmdArgs hakyllArgs --- | Build the site----build :: HakyllConfiguration -> RulesM a -> IO ()-build conf rules = do- _ <- run conf rules- return ()+ let verbosity' = if verbose args' then Logger.Debug else Logger.Message+ check' =+ if internal_links args' then Check.InternalLinks else Check.All --- | Remove the output directories----clean :: HakyllConfiguration -> IO ()-clean conf = do- remove $ destinationDirectory conf- remove $ storeDirectory conf- where- remove dir = do- putStrLn $ "Removing " ++ dir ++ "..."- exists <- doesDirectoryExist dir- when exists $ removeDirectoryRecursive dir+ case args' of+ Build _ -> Commands.build conf verbosity' rules+ Check _ _ -> Commands.check conf verbosity' check'+ Clean _ -> Commands.clean conf+ Deploy _ -> Commands.deploy conf+ Help _ -> showHelp+ Preview _ p -> Commands.preview conf verbosity' rules p+ Rebuild _ -> Commands.rebuild conf verbosity' rules+ Server _ _ -> Commands.server conf (port args') ++-------------------------------------------------------------------------------- -- | Show usage information.----help :: IO ()-help = do- name <- getProgName- mapM_ putStrLn- [ "ABOUT"- , ""- , "This is a Hakyll site generator program. You should always"- , "run it from the project root directory."- , ""- , "USAGE"- , ""- , name ++ " build Generate the site"- , name ++ " clean Clean up and remove cache"- , name ++ " help Show this message"- , name ++ " preview [port] Run a server and autocompile"- , name ++ " rebuild Clean up and build again"- , name ++ " server [port] Run a local test server"- , name ++ " deploy Upload/deploy your site"- , ""- ]+showHelp :: IO ()+showHelp = print $ CA.helpText [] CA.HelpFormatOne $ cmdArgsMode hakyllArgs -#ifndef PREVIEW_SERVER- previewServerDisabled-#endif --- | Preview the site----preview :: HakyllConfiguration -> RulesM a -> Int -> IO ()-#ifdef PREVIEW_SERVER-preview conf rules port = do- -- Fork a thread polling for changes- _ <- forkIO $ previewPoll conf update- - -- Run the server in the main thread- server conf port- where- update = map unResource . S.toList . rulesResources <$> run conf rules-#else-preview _ _ _ = previewServerDisabled-#endif+--------------------------------------------------------------------------------+data HakyllArgs+ = Build {verbose :: Bool}+ | Check {verbose :: Bool, internal_links :: Bool}+ | Clean {verbose :: Bool}+ | Deploy {verbose :: Bool}+ | Help {verbose :: Bool}+ | Preview {verbose :: Bool, port :: Int}+ | Rebuild {verbose :: Bool}+ | Server {verbose :: Bool, port :: Int}+ deriving (Data, Typeable, Show) --- | Rebuild the site----rebuild :: HakyllConfiguration -> RulesM a -> IO ()-rebuild conf rules = do- clean conf- build conf rules --- | Start a server----server :: HakyllConfiguration -> Int -> IO ()-#ifdef PREVIEW_SERVER-server conf port = do- let destination = destinationDirectory conf- staticServer destination preServeHook port- where- preServeHook _ = return ()-#else-server _ _ = previewServerDisabled-#endif+--------------------------------------------------------------------------------+hakyllArgs :: HakyllArgs+hakyllArgs = modes+ [ (Build $ verboseFlag def) &= help "Generate the site"+ , (Check (verboseFlag def) (False &= help "Check internal links only")) &=+ help "Validate the site output"+ , (Clean $ verboseFlag def) &= help "Clean up and remove cache"+ , (Deploy $ verboseFlag def) &= help "Upload/deploy your site"+ , (Help $ verboseFlag def) &= help "Show this message" &= auto+ , (Preview (verboseFlag def) (portFlag 8000)) &=+ help "Start a preview server and autocompile on changes"+ , (Rebuild $ verboseFlag def) &= help "Clean and build again"+ , (Server (verboseFlag def) (portFlag 8000)) &=+ help "Start a preview server"+ ] &= help "Hakyll static site compiler" &= program progName --- | Upload the site----deploy :: HakyllConfiguration -> IO ()-deploy conf = do- _ <- system $ deployCommand conf- return () --- | Print a warning message about the preview serving not being enabled----#ifndef PREVIEW_SERVER-previewServerDisabled :: IO ()-previewServerDisabled =- mapM_ putStrLn- [ "PREVIEW SERVER"- , ""- , "The preview server is not enabled in the version of Hakyll. To"- , "enable it, set the flag to True and recompile Hakyll."- , "Alternatively, use an external tool to serve your site directory."- ]-#endif+--------------------------------------------------------------------------------+verboseFlag :: Data a => a -> a+verboseFlag x = x &= help "Run in verbose mode"+{-# INLINE verboseFlag #-}+++--------------------------------------------------------------------------------+portFlag :: Data a => a -> a+portFlag x = x &= help "Port to listen on"+{-# INLINE portFlag #-}+++--------------------------------------------------------------------------------+-- | This is necessary because not everyone calls their program the same...+progName :: String+progName = unsafePerformIO getProgName+{-# NOINLINE progName #-}
+ src/Hakyll/Preview/Poll.hs view
@@ -0,0 +1,48 @@+--------------------------------------------------------------------------------+-- | Interval-based implementation of preview polling+{-# LANGUAGE CPP #-}+module Hakyll.Preview.Poll+ ( previewPoll+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Control.Concurrent (threadDelay)+import Control.Monad (filterM)+#if MIN_VERSION_directory(1,2,0)+import Data.Time (getCurrentTime)+#else+import System.Time (getClockTime)+#endif+import System.Directory (doesFileExist, getModificationTime)+++--------------------------------------------------------------------------------+import Hakyll.Core.Configuration+++--------------------------------------------------------------------------------+-- | A preview thread that periodically recompiles the site.+previewPoll :: Configuration -- ^ Configuration+ -> IO [FilePath] -- ^ Updating action+ -> IO () -- ^ Can block forever+previewPoll _ update = do+#if MIN_VERSION_directory(1,2,0)+ time <- getCurrentTime+#else+ time <- getClockTime+#endif+ loop time =<< update+ where+ delay = 1000000+ loop time files = do+ threadDelay delay+ files' <- filterM doesFileExist files+ filesTime <- case files' of+ [] -> return time+ _ -> maximum <$> mapM getModificationTime files'++ if filesTime > time || files' /= files+ then loop filesTime =<< update+ else loop time files'
+ src/Hakyll/Preview/Server.hs view
@@ -0,0 +1,43 @@+--------------------------------------------------------------------------------+-- | Implements a basic static file server for previewing options+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Preview.Server+ ( staticServer+ ) where+++--------------------------------------------------------------------------------+import Control.Monad.Trans (liftIO)+import qualified Snap.Core as Snap+import qualified Snap.Http.Server as Snap+import qualified Snap.Util.FileServe as Snap+++--------------------------------------------------------------------------------+-- | Serve a given directory+static :: FilePath -- ^ Directory to serve+ -> (FilePath -> IO ()) -- ^ Pre-serve hook+ -> Snap.Snap ()+static directory preServe =+ Snap.serveDirectoryWith directoryConfig directory+ where+ directoryConfig :: Snap.DirectoryConfig Snap.Snap+ directoryConfig = Snap.fancyDirectoryConfig+ { Snap.preServeHook = liftIO . preServe+ }+++--------------------------------------------------------------------------------+-- | Main method, runs a static server in the given directory+staticServer :: FilePath -- ^ Directory to serve+ -> (FilePath -> IO ()) -- ^ Pre-serve hook+ -> Int -- ^ Port to listen on+ -> IO () -- ^ Blocks forever+staticServer directory preServe port =+ Snap.httpServe config $ static directory preServe+ where+ -- Snap server config+ config = Snap.setPort port+ $ Snap.setAccessLog Snap.ConfigNoLog+ $ Snap.setErrorLog Snap.ConfigNoLog+ $ Snap.emptyConfig
− src/Hakyll/Web/Blaze.hs
@@ -1,35 +0,0 @@--- | Module providing BlazeHtml support for hakyll----module Hakyll.Web.Blaze- ( getFieldHtml- , getFieldHtml'- , getBodyHtml- , getBodyHtml'- ) where--import Text.Blaze.Html (Html, toHtml)-import Text.Blaze.Internal (preEscapedString)--import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata---- | Get a field from a page and convert it to HTML. This version does not--- escape the given HTML----getFieldHtml :: String -> Page a -> Html-getFieldHtml key = preEscapedString . getField key---- | Version of 'getFieldHtml' that escapes the HTML content----getFieldHtml' :: String -> Page a -> Html-getFieldHtml' key = toHtml . getField key---- | Get the body as HTML----getBodyHtml :: Page String -> Html-getBodyHtml = preEscapedString . pageBody---- | Version of 'getBodyHtml' that escapes the HTML content----getBodyHtml' :: Page String -> Html-getBodyHtml' = toHtml . pageBody
src/Hakyll/Web/CompressCss.hs view
@@ -1,51 +1,60 @@+-------------------------------------------------------------------------------- -- | Module used for CSS compression. The compression is currently in a simple -- state, but would typically reduce the number of bytes by about 25%.--- module Hakyll.Web.CompressCss ( compressCssCompiler , compressCss ) where -import Data.Char (isSpace)-import Data.List (isPrefixOf)-import Control.Arrow ((>>^)) -import Hakyll.Core.Compiler-import Hakyll.Core.Resource-import Hakyll.Core.Util.String+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Data.Char (isSpace)+import Data.List (isPrefixOf) ++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Core.Util.String+++-------------------------------------------------------------------------------- -- | Compiler form of 'compressCss'----compressCssCompiler :: Compiler Resource String-compressCssCompiler = getResourceString >>^ compressCss+compressCssCompiler :: Compiler (Item String)+compressCssCompiler = fmap compressCss <$> getResourceString ++-------------------------------------------------------------------------------- -- | Compress CSS to speed up your site.--- compressCss :: String -> String-compressCss = compressSeparators- . stripComments- . compressWhitespace+compressCss = compressSeparators . stripComments . compressWhitespace ++-------------------------------------------------------------------------------- -- | Compresses certain forms of separators.--- compressSeparators :: String -> String-compressSeparators = replaceAll "; *}" (const "}")- . replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace)- . replaceAll ";+" (const ";")+compressSeparators =+ replaceAll "; *}" (const "}") .+ replaceAll " *([{};:]) *" (take 1 . dropWhile isSpace) .+ replaceAll ";+" (const ";") ++-------------------------------------------------------------------------------- -- | Compresses all whitespace.--- compressWhitespace :: String -> String compressWhitespace = replaceAll "[ \t\n\r]+" (const " ") ++-------------------------------------------------------------------------------- -- | Function that strips CSS comments away.--- stripComments :: String -> String stripComments [] = [] stripComments str | isPrefixOf "/*" str = stripComments $ eatComments $ drop 2 str | otherwise = head str : stripComments (drop 1 str) where- eatComments str' | null str' = []- | isPrefixOf "*/" str' = drop 2 str'- | otherwise = eatComments $ drop 1 str'+ eatComments str'+ | null str' = []+ | isPrefixOf "*/" str' = drop 2 str'+ | otherwise = eatComments $ drop 1 str'
src/Hakyll/Web/Feed.hs view
@@ -1,10 +1,11 @@+-------------------------------------------------------------------------------- -- | A Module that allows easy rendering of RSS feeds. -- -- The main rendering functions (@renderRss@, @renderAtom@) all assume that -- you pass the list of items so that the most recent entry in the feed is the -- first item in the list. ----- Also note that the pages should have (at least) the following fields to+-- Also note that the context should have (at least) the following fields to -- produce a correct feed: -- -- - @$title$@: Title of the item@@ -14,29 +15,34 @@ -- - @$url$@: URL to the item - this is usually set automatically. -- -- In addition, the posts should be named according to the rules for--- 'Hakyll.Page.Metadata.renderDateField'.---+-- 'Hakyll.Web.Template.Context.dateField' module Hakyll.Web.Feed ( FeedConfiguration (..) , renderRss , renderAtom ) where -import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow ((>>>), arr, (&&&))-import Control.Monad ((<=<))-import Data.Maybe (fromMaybe, listToMaybe) -import Hakyll.Core.Compiler-import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Template-import Hakyll.Web.Template.Read.Hakyll (readTemplate)-import Hakyll.Web.Urls+--------------------------------------------------------------------------------+import Control.Monad ((<=<))+import Data.Monoid (mconcat) -import Paths_hakyll +--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Item+import Hakyll.Web.Template+import Hakyll.Web.Template.Context+import Hakyll.Web.Template.List+import Hakyll.Web.Template.Read+++--------------------------------------------------------------------------------+import Paths_hakyll+++-------------------------------------------------------------------------------- -- | This is a data structure to keep the configuration of a feed. data FeedConfiguration = FeedConfiguration { -- | Title of the feed.@@ -51,83 +57,73 @@ feedRoot :: String } deriving (Show, Eq) --- | This is an auxiliary function to create a listing that is, in fact, a feed.--- The items should be sorted on date. The @$updated@ field should be set for--- each item.----createFeed :: Template -- ^ Feed template- -> Template -- ^ Item template- -> String -- ^ URL of the feed- -> FeedConfiguration -- ^ Feed configuration- -> [Page String] -- ^ Items to include- -> String -- ^ Resulting feed-createFeed feedTemplate itemTemplate url configuration items =- pageBody $ applyTemplate feedTemplate- $ trySetField "updated" updated- $ trySetField "title" (feedTitle configuration)- $ trySetField "description" (feedDescription configuration)- $ trySetField "authorName" (feedAuthorName configuration)- $ trySetField "authorEmail" (feedAuthorEmail configuration)- $ trySetField "root" (feedRoot configuration)- $ trySetField "url" url- $ fromBody body- where- -- Preprocess items- items' = flip map items $ applyTemplate itemTemplate- . trySetField "root" (feedRoot configuration) - -- Body: concatenated items- body = concat $ map pageBody items'-- -- Take the first updated, which should be the most recent- updated = fromMaybe "Unknown" $ do- p <- listToMaybe items- return $ getField "updated" p--+-------------------------------------------------------------------------------- -- | Abstract function to render any feed.----renderFeed :: FilePath -- ^ Feed template- -> FilePath -- ^ Item template- -> FeedConfiguration -- ^ Feed configuration- -> Compiler [Page String] String -- ^ Feed compiler-renderFeed feedTemplate itemTemplate configuration =- id &&& getRoute >>> renderFeed'- where- -- Arrow rendering the feed from the items and the URL- renderFeed' = unsafeCompiler $ \(items, url) -> do- feedTemplate' <- loadTemplate feedTemplate- itemTemplate' <- loadTemplate itemTemplate- let url' = toUrl $ fromMaybe noUrl url- return $ createFeed feedTemplate' itemTemplate' url' configuration items+renderFeed :: FilePath -- ^ Feed template+ -> FilePath -- ^ Item template+ -> FeedConfiguration -- ^ Feed configuration+ -> Context String -- ^ Context for the items+ -> [Item String] -- ^ Input items+ -> Compiler (Item String) -- ^ Resulting item+renderFeed feedPath itemPath config itemContext items = do+ feedTpl <- compilerUnsafeIO $ loadTemplate feedPath+ itemTpl <- compilerUnsafeIO $ loadTemplate itemPath + body <- makeItem =<< applyTemplateList itemTpl itemContext' items+ applyTemplate feedTpl feedContext body+ where -- Auxiliary: load a template from a datafile loadTemplate = fmap readTemplate . readFile <=< getDataFileName - -- URL is required to have a valid field- noUrl = error "Hakyll.Web.Feed.renderFeed: no route specified"+ itemContext' = mconcat+ [ constField "root" (feedRoot config)+ , itemContext+ ] + feedContext = mconcat+ [ bodyField "body"+ , constField "title" (feedTitle config)+ , constField "description" (feedDescription config)+ , constField "authorName" (feedAuthorName config)+ , constField "authorEmail" (feedAuthorEmail config)+ , constField "root" (feedRoot config)+ , urlField "url"+ , updatedField+ , missingField+ ]++ -- Take the first "updated" field from all items -- this should be the most+ -- recent.+ updatedField = field "updated" $ \_ -> case items of+ [] -> return "Unknown"+ (x : _) -> unContext itemContext' "updated" x+++-------------------------------------------------------------------------------- -- | Render an RSS feed with a number of items.----renderRss :: FeedConfiguration -- ^ Feed configuration- -> Compiler [Page String] String -- ^ Feed compiler-renderRss configuration = arr (map (addUpdated . renderDate))- >>> renderFeed "templates/rss.xml" "templates/rss-item.xml" configuration- where- renderDate = renderDateField "published" "%a, %d %b %Y %H:%M:%S UT"- "No date found."+renderRss :: FeedConfiguration -- ^ Feed configuration+ -> Context String -- ^ Item context+ -> [Item String] -- ^ Feed items+ -> Compiler (Item String) -- ^ Resulting feed+renderRss config context = renderFeed+ "templates/rss.xml" "templates/rss-item.xml" config+ (makeItemContext "%a, %d %b %Y %H:%M:%S UT" context) ++-------------------------------------------------------------------------------- -- | Render an Atom feed with a number of items.----renderAtom :: FeedConfiguration -- ^ Feed configuration- -> Compiler [Page String] String -- ^ Feed compiler-renderAtom configuration = arr (map (addUpdated . renderDate))- >>> renderFeed "templates/atom.xml" "templates/atom-item.xml" configuration- where- renderDate = renderDateField "published" "%Y-%m-%dT%H:%M:%SZ"- "No date found."+renderAtom :: FeedConfiguration -- ^ Feed configuration+ -> Context String -- ^ Item context+ -> [Item String] -- ^ Feed items+ -> Compiler (Item String) -- ^ Resulting feed+renderAtom config context = renderFeed+ "templates/atom.xml" "templates/atom-item.xml" config+ (makeItemContext "%Y-%m-%dT%H:%M:%SZ" context) ++-------------------------------------------------------------------------------- -- | Copies @$updated$@ from @$published$@ if it is not already set.----addUpdated :: Page a -> Page a-addUpdated page = trySetField "updated" (getField "published" page) page+makeItemContext :: String -> Context a -> Context a+makeItemContext fmt context = mconcat+ [dateField "published" fmt, context, dateField "updated" fmt]
+ src/Hakyll/Web/Html.hs view
@@ -0,0 +1,155 @@+--------------------------------------------------------------------------------+-- | Provides utilities to manipulate HTML pages+module Hakyll.Web.Html+ ( -- * Generic+ withTags++ -- * Headers+ , demoteHeaders++ -- * Url manipulation+ , getUrls+ , withUrls+ , toUrl+ , toSiteRoot+ , isExternal++ -- * Stripping/escaping+ , stripTags+ , escapeHtml+ ) where+++--------------------------------------------------------------------------------+import Data.Char (digitToInt, intToDigit,+ isDigit, toLower)+import Data.List (isPrefixOf)+import System.FilePath (joinPath, splitPath,+ takeDirectory)+import Text.Blaze.Html (toHtml)+import Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.HTML.TagSoup as TS+++--------------------------------------------------------------------------------+-- | Map over all tags in the document+withTags :: (TS.Tag String -> TS.Tag String) -> String -> String+withTags f = renderTags' . map f . TS.parseTags+++--------------------------------------------------------------------------------+-- | Map every @h1@ to an @h2@, @h2@ to @h3@, etc.+demoteHeaders :: String -> String+demoteHeaders = withTags $ \tag -> case tag of+ TS.TagOpen t a -> TS.TagOpen (demote t) a+ TS.TagClose t -> TS.TagClose (demote t)+ t -> t+ where+ demote t@['h', n]+ | isDigit n = ['h', intToDigit (min 6 $ digitToInt n + 1)]+ | otherwise = t+ demote t = t+++--------------------------------------------------------------------------------+isUrlAttribute :: String -> Bool+isUrlAttribute = (`elem` ["src", "href"])+++--------------------------------------------------------------------------------+getUrls :: [TS.Tag String] -> [String]+getUrls tags = [v | TS.TagOpen _ as <- tags, (k, v) <- as, isUrlAttribute k]+++--------------------------------------------------------------------------------+-- | Apply a function to each URL on a webpage+withUrls :: (String -> String) -> String -> String+withUrls f = withTags tag+ where+ tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a+ tag x = x+ attr (k, v) = (k, if isUrlAttribute k then f v else v)+++-- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS+-- within style tags.)+renderTags' :: [TS.Tag String] -> String+renderTags' = TS.renderTagsOptions TS.renderOptions+ { TS.optRawTag = (`elem` ["script", "style"]) . map toLower+ , TS.optMinimize = (`elem` ["br", "img"])+ }+++--------------------------------------------------------------------------------+-- | Convert a filepath to an URL starting from the site root+--+-- Example:+--+-- > toUrl "foo/bar.html"+--+-- Result:+--+-- > "/foo/bar.html"+toUrl :: FilePath -> String+toUrl ('/' : xs) = '/' : xs+toUrl url = '/' : url+++--------------------------------------------------------------------------------+-- | Get the relative url to the site root, for a given (absolute) url+toSiteRoot :: String -> String+toSiteRoot = emptyException . joinPath . map parent+ . filter relevant . splitPath . takeDirectory+ where+ parent = const ".."+ emptyException [] = "."+ emptyException x = x+ relevant "." = False+ relevant "/" = False+ relevant _ = True+++--------------------------------------------------------------------------------+-- | Check if an URL links to an external HTTP(S) source+isExternal :: String -> Bool+isExternal url = any (flip isPrefixOf url) ["http://", "https://"]+++--------------------------------------------------------------------------------+-- | Strip all HTML tags from a string+--+-- Example:+--+-- > stripTags "<p>foo</p>"+--+-- Result:+--+-- > "foo"+--+-- This also works for incomplete tags+--+-- Example:+--+-- > stripTags "<p>foo</p"+--+-- Result:+--+-- > "foo"+stripTags :: String -> String+stripTags [] = []+stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs+stripTags (x : xs) = x : stripTags xs+++--------------------------------------------------------------------------------+-- | HTML-escape a string+--+-- Example:+--+-- > escapeHtml "Me & Dean"+--+-- Result:+--+-- > "Me & Dean"+escapeHtml :: String -> String+escapeHtml = renderHtml . toHtml
+ src/Hakyll/Web/Html/RelativizeUrls.hs view
@@ -0,0 +1,52 @@+--------------------------------------------------------------------------------+-- | This module exposes a function which can relativize URL's on a webpage.+--+-- This means that one can deploy the resulting site on+-- @http:\/\/example.com\/@, but also on @http:\/\/example.com\/some-folder\/@+-- without having to change anything (simply copy over the files).+--+-- To use it, you should use absolute URL's from the site root everywhere. For+-- example, use+--+-- > <img src="/images/lolcat.png" alt="Funny zomgroflcopter" />+--+-- in a blogpost. When running this through the relativize URL's module, this+-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:+--+-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />+module Hakyll.Web.Html.RelativizeUrls+ ( relativizeUrls+ , relativizeUrlsWith+ ) where+++--------------------------------------------------------------------------------+import Data.List (isPrefixOf)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Web.Html+++--------------------------------------------------------------------------------+-- | Compiler form of 'relativizeUrls' which automatically picks the right root+-- path+relativizeUrls :: Item String -> Compiler (Item String)+relativizeUrls item = do+ route <- getRoute $ itemIdentifier item+ return $ case route of+ Nothing -> item+ Just r -> fmap (relativizeUrlsWith $ toSiteRoot r) item+++--------------------------------------------------------------------------------+-- | Relativize URL's in HTML+relativizeUrlsWith :: String -- ^ Path to the site root+ -> String -- ^ HTML to relativize+ -> String -- ^ Resulting HTML+relativizeUrlsWith root = withUrls rel+ where+ isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)+ rel x = if isRel x then root ++ x else x
− src/Hakyll/Web/Page.hs
@@ -1,156 +0,0 @@--- | A page is a key-value mapping, representing a page on your site------ A page is an important concept in Hakyll. It is a key-value mapping, and has--- one field with an arbitrary type. A 'Page' thus consists of------ * metadata (of the type @Map String String@);------ * the actual value (of the type @a@).------ Usually, the value will be a 'String' as well, and the value will be the body--- of the page.------ However, this is certainly no restriction. For example, @Page ByteString@--- could be used to represent a binary item (e.g. an image) and some metadata.------ Pages can be constructed using Haskell, but they are usually parsed from a--- file. The file format for pages is pretty straightforward.------ > This is a simple page--- > consisting of two lines.------ This is a valid page with two lines. If we load this in Hakyll, there would--- be no metadata, and the body would be the given text. Let's look at a page--- with some metadata:------ > ------ > title: Alice's Adventures in Wonderland--- > author: Lewis Caroll--- > year: 1865--- > ------ >--- > Chapter I--- > =========--- >--- > Down the Rabbit-Hole--- > ----------------------- >--- > Alice was beginning to get very tired of sitting by her sister on the bank,--- > and of having nothing to do: once or twice she had peeped into the book her--- > sister was reading, but it had no pictures or conversations in it, "and--- > what is the use of a book," thought Alice "without pictures or--- > conversation?"--- >--- > ...------ As you can see, we construct a metadata header in Hakyll using @---@. Then,--- we simply list all @key: value@ pairs, and end with @---@ again. This page--- contains three metadata fields and a body. The body is given in markdown--- format, which can be easily rendered to HTML by Hakyll, using pandoc.----{-# LANGUAGE DeriveDataTypeable #-}-module Hakyll.Web.Page- ( Page (..)- , fromBody- , fromMap- , toMap- , readPageCompiler- , pageCompiler- , pageCompilerWith- , pageCompilerWithPandoc- , pageCompilerWithFields- , addDefaultFields- ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow (arr, (>>^), (&&&), (>>>))-import System.FilePath (takeBaseName, takeDirectory)-import qualified Data.Map as M--import Text.Pandoc (Pandoc, ParserState, WriterOptions)--import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Resource-import Hakyll.Web.Page.Internal-import Hakyll.Web.Page.Read-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Pandoc-import Hakyll.Web.Template-import Hakyll.Web.Urls---- | Create a page from a body, without metadata----fromBody :: a -> Page a-fromBody = Page M.empty---- | Read a page (do not render it)----readPageCompiler :: Compiler Resource (Page String)-readPageCompiler = getResourceString >>^ readPage---- | Read a page, add default fields, substitute fields and render using pandoc----pageCompiler :: Compiler Resource (Page String)-pageCompiler =- pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions---- | A version of 'pageCompiler' which allows you to specify your own pandoc--- options----pageCompilerWith :: ParserState -> WriterOptions- -> Compiler Resource (Page String)-pageCompilerWith state options = pageCompilerWithPandoc state options id---- | An extension of 'pageCompilerWith' which allows you to specify a custom--- pandoc transformer for the content----pageCompilerWithPandoc :: ParserState -> WriterOptions- -> (Pandoc -> Pandoc)- -> Compiler Resource (Page String)-pageCompilerWithPandoc state options f = cached cacheName $- readPageCompiler >>> addDefaultFields >>> arr applySelf- >>> pageReadPandocWith state- >>> arr (fmap (writePandocWith options . f))- where- cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"---- | This is another, even more advanced version of 'pageCompilerWithPandoc'.--- This function allows you to provide an arrow which is applied before the--- fields in a page are rendered. This means you can use this extra customizable--- stage to add custom fields which are inserted in the page.----pageCompilerWithFields :: ParserState -> WriterOptions- -> (Pandoc -> Pandoc)- -> Compiler (Page String) (Page String)- -> Compiler Resource (Page String)-pageCompilerWithFields state options f g =- readPageCompiler >>> addDefaultFields >>> g >>> arr applySelf- >>> pageReadPandocWith state- >>> arr (fmap (writePandocWith options . f))---- | Add a number of default metadata fields to a page. These fields include:------ * @$url$@------ * @$category$@------ * @$title$@------ * @$path$@----addDefaultFields :: Compiler (Page a) (Page a)-addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)- >>> (getIdentifier &&& id >>^ uncurry addIdentifier)- where- -- Add root and url, based on route- addRoute Nothing = id- addRoute (Just r) = trySetField "url" (toUrl r)-- -- Add title and category, based on identifier- addIdentifier i = trySetField "title" (takeBaseName p)- . trySetField "category" (takeBaseName $ takeDirectory p)- . trySetField "path" p- where- p = toFilePath i
− src/Hakyll/Web/Page/Internal.hs
@@ -1,50 +0,0 @@--- | Internal representation of the page datatype----{-# LANGUAGE DeriveDataTypeable #-}-module Hakyll.Web.Page.Internal- ( Page (..)- , fromMap- , toMap- ) where--import Control.Applicative ((<$>), (<*>))-import Data.Monoid (Monoid, mempty, mappend)--import Data.Map (Map)-import Data.Binary (Binary, get, put)-import Data.Typeable (Typeable)-import qualified Data.Map as M--import Hakyll.Core.Writable---- | Type used to represent pages----data Page a = Page- { pageMetadata :: Map String String- , pageBody :: a- } deriving (Eq, Show, Typeable)--instance Monoid a => Monoid (Page a) where- mempty = Page M.empty mempty- mappend (Page m1 b1) (Page m2 b2) =- Page (M.union m1 m2) (mappend b1 b2)--instance Functor Page where- fmap f (Page m b) = Page m (f b)--instance Binary a => Binary (Page a) where- put (Page m b) = put m >> put b- get = Page <$> get <*> get--instance Writable a => Writable (Page a) where- write p (Page _ b) = write p b---- | Create a metadata page, without a body----fromMap :: Monoid a => Map String String -> Page a-fromMap m = Page m mempty---- | Convert a page to a map. The body will be placed in the @body@ key.----toMap :: Page String -> Map String String-toMap (Page m b) = M.insert "body" b m
− src/Hakyll/Web/Page/List.hs
@@ -1,82 +0,0 @@--- | Provides an easy way to combine several pages in a list. The applications--- are obvious:------ * A post list on a blog------ * An image list in a gallery------ * A sitemap----module Hakyll.Web.Page.List- ( setFieldPageList- , pageListCompiler- , chronological- , recentFirst- , sortByBaseName- ) where--import Control.Arrow ((>>>), arr)-import Data.List (sortBy)-import Data.Monoid (Monoid, mconcat)-import Data.Ord (comparing)-import System.FilePath (takeBaseName)--import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Template---- | Set a field of a page to a listing of pages----setFieldPageList :: ([Page String] -> [Page String]) - -- ^ Determines list order- -> Identifier Template - -- ^ Applied to every page- -> String- -- ^ Key indicating which field should be set- -> Pattern (Page String) - -- ^ Selects pages to include in the list- -> Compiler (Page String) (Page String)- -- ^ Compiler that sets the page list in a field-setFieldPageList sort template key pattern =- requireAllA pattern $ setFieldA key $ pageListCompiler sort template---- | Create a list of pages----pageListCompiler :: ([Page String] -> [Page String]) -- ^ Determine list order- -> Identifier Template -- ^ Applied to pages- -> Compiler [Page String] String -- ^ Compiles page list-pageListCompiler sort template =- arr sort >>> applyTemplateToList template >>> arr concatPages---- | Apply a template to every page in a list----applyTemplateToList :: Identifier Template- -> Compiler [Page String] [Page String]-applyTemplateToList identifier =- require identifier $ \posts template -> map (applyTemplate template) posts---- | Concatenate the bodies of a page list----concatPages :: Monoid m => [Page m] -> m-concatPages = mconcat . map pageBody---- | Sort pages chronologically. This function assumes that the pages have a--- @year-month-day-title.extension@ naming scheme -- as is the convention in--- Hakyll.----chronological :: [Page a] -> [Page a]-chronological = sortBy $ comparing $ takeBaseName . getField "path"---- | The reverse of 'chronological'----recentFirst :: [Page a] -> [Page a]-recentFirst = reverse . chronological---- | Deprecated, see 'chronological'----sortByBaseName :: [Page a] -> [Page a]-sortByBaseName = chronological-{-# DEPRECATED sortByBaseName "Use chronological" #-}
− src/Hakyll/Web/Page/Metadata.hs
@@ -1,235 +0,0 @@--- | Provides various functions to manipulate the metadata fields of a page----module Hakyll.Web.Page.Metadata- ( getField- , getFieldMaybe- , setField- , trySetField- , setFieldA- , setFieldPage- , renderField- , changeField- , copyField- , renderDateField- , renderDateFieldWith- , renderModificationTime- , renderModificationTimeWith- , copyBodyToField- , copyBodyFromField- , comparePagesByDate- ) where--import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))-import Control.Category (id)-import Control.Monad (msum)-import Data.List (intercalate)-import Data.Maybe (fromMaybe)-import Data.Ord (comparing)-import Prelude hiding (id)-import System.FilePath (takeFileName)-import System.Locale (TimeLocale, defaultTimeLocale)-import qualified Data.Map as M--import Data.Time.Calendar (Day (..))-import Data.Time.Clock (UTCTime (..))-import Data.Time.Format (parseTime, formatTime)--import Hakyll.Web.Page.Internal-import Hakyll.Core.Util.String-import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider---- | Get a metadata field. If the field does not exist, the empty string is--- returned.----getField :: String -- ^ Key- -> Page a -- ^ Page- -> String -- ^ Value-getField key = fromMaybe "" . getFieldMaybe key---- | Get a field in a 'Maybe' wrapper----getFieldMaybe :: String -- ^ Key- -> Page a -- ^ Page- -> Maybe String -- ^ Value, if found-getFieldMaybe key = M.lookup key . pageMetadata---- | Version of 'trySetField' which overrides any previous value----setField :: String -- ^ Key- -> String -- ^ Value- -> Page a -- ^ Page to add it to- -> Page a -- ^ Resulting page-setField k v (Page m b) = Page (M.insert k v m) b---- | Add a metadata field. If the field already exists, it is not overwritten.----trySetField :: String -- ^ Key- -> String -- ^ Value- -> Page a -- ^ Page to add it to- -> Page a -- ^ Resulting page-trySetField k v (Page m b) = Page (M.insertWith (flip const) k v m) b---- | Arrow-based variant of 'setField'. Because of it's type, this function is--- very usable together with the different 'require' functions.----setFieldA :: Arrow a- => String -- ^ Key- -> a x String -- ^ Value arrow- -> a (Page b, x) (Page b) -- ^ Resulting arrow-setFieldA k v = id *** v >>> arr (uncurry $ flip $ setField k)---- | Set a field of a page to the contents of another page----setFieldPage :: String -- ^ Key to add the page under- -> Identifier (Page String) -- ^ Page to add- -> Compiler (Page a) (Page a) -- ^ Page compiler-setFieldPage key page = id &&& require_ page >>> setFieldA key (arr pageBody)---- | Do something with a metadata value, but keep the old value as well. If the--- key given is not present in the metadata, nothing will happen. If the source--- and destination keys are the same, the value will be changed (but you should--- use 'changeField' for this purpose).----renderField :: String -- ^ Key of which the value should be copied- -> String -- ^ Key the value should be copied to- -> (String -> String) -- ^ Function to apply on the value- -> Page a -- ^ Page on which this should be applied- -> Page a -- ^ Resulting page-renderField src dst f page = case M.lookup src (pageMetadata page) of- Nothing -> page- Just value -> setField dst (f value) page---- | Change a metadata value.------ > import Data.Char (toUpper)--- > changeField "title" (map toUpper)------ Will put the title in UPPERCASE.----changeField :: String -- ^ Key to change.- -> (String -> String) -- ^ Function to apply on the value.- -> Page a -- ^ Page to change- -> Page a -- ^ Resulting page-changeField key = renderField key key---- | Make a copy of a metadata field (put the value belonging to a certain key--- under some other key as well)----copyField :: String -- ^ Key to copy- -> String -- ^ Destination to copy to- -> Page a -- ^ Page on which this should be applied- -> Page a -- ^ Resulting page-copyField src dst = renderField src dst id---- | When the metadata has a field called @published@ in one of the--- following formats then this function can render the date.------ * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)------ * @2000-02-01T13:00:00Z@ (Atom date format)------ * @February 1, 2000 1:00 PM@ (PM is usually uppercase)------ * @February 1, 2000@ (assumes 12:00 AM for the time)------ Alternatively, when the metadata has a field called @path@ in a--- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)--- and no @published@ metadata field set, this function can render--- the date.------ > renderDateField "date" "%B %e, %Y" "Date unknown"------ Will render something like @January 32, 2010@.----renderDateField :: String -- ^ Key in which the rendered date should be placed- -> String -- ^ Format to use on the date- -> String -- ^ Default value, in case the date cannot be parsed- -> Page a -- ^ Page on which this should be applied- -> Page a -- ^ Resulting page-renderDateField = renderDateFieldWith defaultTimeLocale---- | This is an extended version of 'renderDateField' that allows you to--- specify a time locale that is used for outputting the date. For more--- details, see 'renderDateField'.----renderDateFieldWith :: TimeLocale -- ^ Output time locale- -> String -- ^ Destination key- -> String -- ^ Format to use on the date- -> String -- ^ Default value- -> Page a -- ^ Target page- -> Page a -- ^ Resulting page-renderDateFieldWith locale key format defaultValue page =- setField key renderTimeString page- where- renderTimeString = fromMaybe defaultValue $ do- time <- getUTCMaybe locale page- return $ formatTime locale format time---- | Parser to try to extract and parse the time from the @published@--- field or from the filename. See 'renderDateField' for more information.-getUTCMaybe :: TimeLocale -- ^ Output time locale- -> Page a -- ^ Input page- -> Maybe UTCTime -- ^ Parsed UTCTime-getUTCMaybe locale page = msum $- [fromField "published" fmt | fmt <- formats] ++- [fromField "date" fmt | fmt <- formats] ++- [ getFieldMaybe "path" page >>= parseTime' "%Y-%m-%d" .- intercalate "-" . take 3 . splitAll "-" . takeFileName- ]- where- parseTime' f str = parseTime locale f str- fromField k fmt = getFieldMaybe k page >>= parseTime' fmt-- formats =- [ "%a, %d %b %Y %H:%M:%S UT"- , "%Y-%m-%dT%H:%M:%SZ"- , "%Y-%m-%d %H:%M:%S"- , "%Y-%m-%d"- , "%B %e, %Y %l:%M %p"- , "%B %e, %Y"- ]---- | Set the modification time as a field in the page-renderModificationTime :: String- -- ^ Destination key- -> String- -- ^ Format to use on the time- -> Compiler (Page String) (Page String)- -- ^ Resulting compiler-renderModificationTime = renderModificationTimeWith defaultTimeLocale--renderModificationTimeWith :: TimeLocale- -- ^ Output time locale- -> String- -- ^ Destination key- -> String- -- ^ Format to use on the time- -> Compiler (Page String) (Page String)- -- ^ Resulting compiler-renderModificationTimeWith locale key format =- id &&& (getResource >>> getResourceWith resourceModificationTime) >>>- setFieldA key (arr (formatTime locale format))---- | Copy the body of a page to a metadata field----copyBodyToField :: String -- ^ Destination key- -> Page String -- ^ Target page- -> Page String -- ^ Resulting page-copyBodyToField key page = setField key (pageBody page) page---- | Copy a metadata field to the page body----copyBodyFromField :: String -- ^ Source key- -> Page String -- ^ Target page- -> Page String -- ^ Resulting page-copyBodyFromField key page = fmap (const $ getField key page) page---- | Compare pages by the date and time parsed as in 'renderDateField',--- where 'LT' implies earlier, and 'GT' implies later. For more details,--- see 'renderDateField'.-comparePagesByDate :: Page a -> Page a -> Ordering-comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale- where- zero = UTCTime (ModifiedJulianDay 0) 0
− src/Hakyll/Web/Page/Read.hs
@@ -1,61 +0,0 @@--- | Module providing a function to parse a page from a file----module Hakyll.Web.Page.Read- ( readPage- ) where--import Control.Applicative ((<$>), (<*>), (<*), (<|>))-import qualified Data.Map as M--import Text.Parsec.Char (alphaNum, anyChar, char, oneOf, string)-import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1)-import Text.Parsec.Prim (many, parse, skipMany, (<?>))-import Text.Parsec.String (Parser)--import Hakyll.Core.Util.String-import Hakyll.Web.Page.Internal---- | Space or tab, no newline-inlineSpace :: Parser Char-inlineSpace = oneOf ['\t', ' '] <?> "space"---- | Parse Windows newlines as well (i.e. "\n" or "\r\n")-newline :: Parser String-newline = string "\n" -- Unix- <|> string "\r\n" -- DOS---- | Parse a single metadata field----metadataField :: Parser (String, String)-metadataField = do- key <- manyTill alphaNum $ char ':'- skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key- value <- manyTill anyChar newline- trailing' <- many trailing- return (key, trim $ value ++ concat trailing')- where- trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline---- | Parse a metadata block, including delimiters and trailing newlines----metadata :: Parser [(String, String)]-metadata = do- open <- many1 (char '-') <* many inlineSpace <* newline- metadata' <- many metadataField- _ <- choice $ map (string . replicate (length open)) ['-', '.']- skipMany inlineSpace- skipMany1 newline- return metadata'---- | Parse a Hakyll page----page :: Parser ([(String, String)], String)-page = do- metadata' <- option [] metadata- body <- many anyChar- return (metadata', body)--readPage :: String -> Page String-readPage input = case parse page "page" input of- Left err -> error (show err)- Right (md, b) -> Page (M.fromList md) b
src/Hakyll/Web/Pandoc.hs view
@@ -1,113 +1,118 @@--- | Module exporting pandoc bindings---+--------------------------------------------------------------------------------+-- | Module exporting convenient pandoc bindings module Hakyll.Web.Pandoc ( -- * The basic building blocks readPandoc , readPandocWith , writePandoc , writePandocWith+ , renderPandoc+ , renderPandocWith - -- * Functions working on pages/compilers- , pageReadPandoc- , pageReadPandocWith- , pageReadPandocWithA- , pageRenderPandoc- , pageRenderPandocWith+ -- * Derived compilers+ , pandocCompiler+ , pandocCompilerWith+ , pandocCompilerWithTransform -- * Default options , defaultHakyllParserState , defaultHakyllWriterOptions ) where -import Prelude hiding (id)-import Control.Applicative ((<$>))-import Control.Arrow ((>>>), (>>^), (&&&), (***))-import Control.Category (id)-import Data.Maybe (fromMaybe) -import Text.Pandoc+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Text.Pandoc -import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Util.Arrow-import Hakyll.Web.Pandoc.FileType-import Hakyll.Web.Page.Internal +--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Web.Pandoc.FileType+++-------------------------------------------------------------------------------- -- | Read a string using pandoc, with the default options----readPandoc :: FileType -- ^ Determines how parsing happens- -> Maybe (Identifier a) -- ^ Optional, for better error messages- -> String -- ^ String to read- -> Pandoc -- ^ Resulting document+readPandoc :: Item String -- ^ String to read+ -> Item Pandoc -- ^ Resulting document readPandoc = readPandocWith defaultHakyllParserState ++-------------------------------------------------------------------------------- -- | Read a string using pandoc, with the supplied options----readPandocWith :: ParserState -- ^ Parser options- -> FileType -- ^ Determines parsing method- -> Maybe (Identifier a) -- ^ Optional, for better error messages- -> String -- ^ String to read- -> Pandoc -- ^ Resulting document-readPandocWith state fileType' id' = case fileType' of- Html -> readHtml state- LaTeX -> readLaTeX state- LiterateHaskell t ->- readPandocWith state {stateLiterateHaskell = True} t id'- Markdown -> readMarkdown state- Rst -> readRST state- Textile -> readTextile state- t -> error $- "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++- "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id')+readPandocWith :: ParserState -- ^ Parser options+ -> Item String -- ^ String to read+ -> Item Pandoc -- ^ Resulting document+readPandocWith state item = fmap (reader state (itemFileType item)) item+ where+ reader s t = case t of+ Html -> readHtml s+ LaTeX -> readLaTeX s+ LiterateHaskell t' -> reader s {stateLiterateHaskell = True} t'+ Markdown -> readMarkdown s+ Rst -> readRST s+ Textile -> readTextile s+ _ -> error $+ "Hakyll.Web.readPandocWith: I don't know how to read a file of the " +++ "type " ++ show t ++ " for: " ++ show (itemIdentifier item) ++-------------------------------------------------------------------------------- -- | Write a document (as HTML) using pandoc, with the default options----writePandoc :: Pandoc -- ^ Document to write- -> String -- ^ Resulting HTML+writePandoc :: Item Pandoc -- ^ Document to write+ -> Item String -- ^ Resulting HTML writePandoc = writePandocWith defaultHakyllWriterOptions ++-------------------------------------------------------------------------------- -- | Write a document (as HTML) using pandoc, with the supplied options--- writePandocWith :: WriterOptions -- ^ Writer options for pandoc- -> Pandoc -- ^ Document to write- -> String -- ^ Resulting HTML-writePandocWith = writeHtmlString+ -> Item Pandoc -- ^ Document to write+ -> Item String -- ^ Resulting HTML+writePandocWith options = fmap $ writeHtmlString options --- | Read the resource using pandoc----pageReadPandoc :: Compiler (Page String) (Page Pandoc)-pageReadPandoc = pageReadPandocWith defaultHakyllParserState --- | Read the resource using pandoc----pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)-pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA+--------------------------------------------------------------------------------+-- | Render the resource using pandoc+renderPandoc :: Item String -> Item String+renderPandoc =+ renderPandocWith defaultHakyllParserState defaultHakyllWriterOptions --- | Read the resource using pandoc. This is a (rarely needed) variant, which--- comes in very useful when the parser state is the result of some arrow.----pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc)-pageReadPandocWithA =- id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'- where- pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) <$> p +-------------------------------------------------------------------------------- -- | Render the resource using pandoc----pageRenderPandoc :: Compiler (Page String) (Page String)-pageRenderPandoc =- pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions+renderPandocWith :: ParserState -> WriterOptions -> Item String -> Item String+renderPandocWith state options = writePandocWith options . readPandocWith state --- | Render the resource using pandoc----pageRenderPandocWith :: ParserState- -> WriterOptions- -> Compiler (Page String) (Page String)-pageRenderPandocWith state options =- pageReadPandocWith state >>^ fmap (writePandocWith options) +--------------------------------------------------------------------------------+-- | Read a page render using pandoc+pandocCompiler :: Compiler (Item String)+pandocCompiler =+ pandocCompilerWith defaultHakyllParserState defaultHakyllWriterOptions+++--------------------------------------------------------------------------------+-- | A version of 'pandocCompiler' which allows you to specify your own pandoc+-- options+pandocCompilerWith :: ParserState -> WriterOptions -> Compiler (Item String)+pandocCompilerWith state options = pandocCompilerWithTransform state options id+++--------------------------------------------------------------------------------+-- | An extension of 'pandocCompilerWith' which allows you to specify a custom+-- pandoc transformation for the content+pandocCompilerWithTransform :: ParserState -> WriterOptions+ -> (Pandoc -> Pandoc)+ -> Compiler (Item String)+pandocCompilerWithTransform state options f = cached cacheName $+ writePandocWith options . fmap f . readPandocWith state <$> getResourceBody+ where+ cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"+++-------------------------------------------------------------------------------- -- | The default reader options for pandoc parsing in hakyll--- defaultHakyllParserState :: ParserState defaultHakyllParserState = defaultParserState { -- The following option causes pandoc to read smart typography, a nice@@ -115,8 +120,9 @@ stateSmart = True } ++-------------------------------------------------------------------------------- -- | The default writer options for pandoc rendering in hakyll--- defaultHakyllWriterOptions :: WriterOptions defaultHakyllWriterOptions = defaultWriterOptions { -- This option causes literate haskell to be written using '>' marks in
src/Hakyll/Web/Pandoc/Biblio.hs view
@@ -1,3 +1,4 @@+-------------------------------------------------------------------------------- -- | Wraps pandocs bibiliography handling -- -- In order to add a bibliography, you will need a bibliography file (e.g.@@ -6,68 +7,96 @@ -- refer to these files when you use 'pageReadPandocBiblio'. This function also -- takes a parser state for completeness -- you can use -- 'defaultHakyllParserState' if you're unsure.----{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE Arrows #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Web.Pandoc.Biblio ( CSL , cslCompiler , Biblio (..) , biblioCompiler- , pageReadPandocBiblio+ , readPandocBiblio ) where -import Control.Applicative ((<$>))-import Control.Arrow (arr, returnA)-import Data.Typeable (Typeable) -import Data.Binary (Binary (..))-import Text.Pandoc (Pandoc, ParserState (..))-import Text.Pandoc.Biblio (processBiblio)-import qualified Text.CSL as CSL+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Data.Binary (Binary (..))+import Data.Typeable (Typeable)+import qualified Text.CSL as CSL+import Text.Pandoc (Pandoc, ParserState (..))+import Text.Pandoc.Biblio (processBiblio) -import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Resource-import Hakyll.Core.Writable-import Hakyll.Web.Page-import Hakyll.Web.Pandoc -newtype CSL = CSL FilePath- deriving (Binary, Show, Typeable, Writable)+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Core.Writable+import Hakyll.Web.Pandoc -cslCompiler :: Compiler Resource CSL-cslCompiler = arr (CSL . unResource) +--------------------------------------------------------------------------------+data CSL = CSL+ deriving (Show, Typeable)+++--------------------------------------------------------------------------------+instance Binary CSL where+ put CSL = return ()+ get = return CSL+++--------------------------------------------------------------------------------+instance Writable CSL where+ -- Shouldn't be written.+ write _ _ = return ()+++--------------------------------------------------------------------------------+cslCompiler :: Compiler (Item CSL)+cslCompiler = makeItem CSL+++-------------------------------------------------------------------------------- newtype Biblio = Biblio [CSL.Reference] deriving (Show, Typeable) ++-------------------------------------------------------------------------------- instance Binary Biblio where -- Ugly. get = Biblio . read <$> get put (Biblio rs) = put $ show rs ++-------------------------------------------------------------------------------- instance Writable Biblio where+ -- Shouldn't be written. write _ _ = return () -biblioCompiler :: Compiler Resource Biblio-biblioCompiler = unsafeCompiler $- fmap Biblio . CSL.readBiblioFile . unResource -pageReadPandocBiblio :: ParserState- -> Identifier CSL- -> Identifier Biblio- -> Compiler (Page String) (Page Pandoc)-pageReadPandocBiblio state csl refs = proc page -> do- CSL csl' <- require_ csl -< ()- Biblio refs' <- require_ refs -< ()+--------------------------------------------------------------------------------+biblioCompiler :: Compiler (Item Biblio)+biblioCompiler = do+ filePath <- toFilePath <$> getUnderlying+ makeItem =<< unsafeCompiler (Biblio <$> CSL.readBiblioFile filePath)+++--------------------------------------------------------------------------------+readPandocBiblio :: ParserState+ -> Item CSL+ -> Item Biblio+ -> (Item String)+ -> Compiler (Item Pandoc)+readPandocBiblio state csl biblio item = do -- We need to know the citation keys, add then *before* actually parsing the -- actual page. If we don't do this, pandoc won't even consider them -- citations!- let cits = map CSL.refId refs'- state' = state {stateCitations = stateCitations state ++ cits}- pandocPage <- pageReadPandocWithA -< (state', page)- let pandoc = pageBody pandocPage- pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)- returnA -< pandocPage {pageBody = pandoc'}- where- processBiblio' (c, r, p) = processBiblio c Nothing r p+ let Biblio refs = itemBody biblio+ cits = map CSL.refId refs+ state' = state {stateCitations = stateCitations state ++ cits}+ pandoc = itemBody $ readPandocWith state' item+ cslPath = toFilePath $ itemIdentifier csl+ pandoc' <- unsafeCompiler $ processBiblio cslPath Nothing refs pandoc+ return $ fmap (const pandoc') item
src/Hakyll/Web/Pandoc/FileType.hs view
@@ -1,20 +1,24 @@+-------------------------------------------------------------------------------- -- | A module dealing with pandoc file extensions and associated file types--- module Hakyll.Web.Pandoc.FileType ( FileType (..) , fileType- , getFileType+ , itemFileType ) where -import System.FilePath (takeExtension)-import Control.Arrow ((>>^)) -import Hakyll.Core.Identifier-import Hakyll.Core.Compiler+--------------------------------------------------------------------------------+import System.FilePath (takeExtension) ++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Item+++-------------------------------------------------------------------------------- -- | Datatype to represent the different file types Hakyll can deal with by -- default--- data FileType = Binary | Css@@ -28,8 +32,9 @@ | Textile deriving (Eq, Ord, Show, Read) ++-------------------------------------------------------------------------------- -- | Get the file type for a certain file. The type is determined by extension.--- fileType :: FilePath -> FileType fileType = fileType' . takeExtension where@@ -53,7 +58,8 @@ fileType' ".txt" = PlainText fileType' _ = Binary -- Treat unknown files as binary ++-------------------------------------------------------------------------------- -- | Get the file type for the current file----getFileType :: Compiler a FileType-getFileType = getIdentifier >>^ fileType . toFilePath+itemFileType :: Item a -> FileType+itemFileType = fileType . toFilePath . itemIdentifier
− src/Hakyll/Web/Preview/Poll.hs
@@ -1,43 +0,0 @@--- | Interval-based implementation of preview polling----{-# LANGUAGE CPP #-}-module Hakyll.Web.Preview.Poll- ( previewPoll- ) where--import Control.Applicative ((<$>))-import Control.Concurrent (threadDelay)-import Control.Monad (filterM)-#if MIN_VERSION_directory(1,2,0)-import Data.Time (getCurrentTime)-#else-import System.Time (getClockTime)-#endif-import System.Directory (getModificationTime, doesFileExist)--import Hakyll.Core.Configuration---- | A preview thread that periodically recompiles the site.----previewPoll :: HakyllConfiguration -- ^ Configuration- -> IO [FilePath] -- ^ Updating action- -> IO () -- ^ Can block forever-previewPoll _ update = do-#if MIN_VERSION_directory(1,2,0)- time <- getCurrentTime-#else- time <- getClockTime-#endif- loop time =<< update- where- delay = 1000000- loop time files = do- threadDelay delay- files' <- filterM doesFileExist files- filesTime <- case files' of- [] -> return time- _ -> maximum <$> mapM getModificationTime files'-- if filesTime > time || files' /= files- then loop filesTime =<< update- else loop time files'
− src/Hakyll/Web/Preview/Server.hs
@@ -1,40 +0,0 @@--- | Implements a basic static file server for previewing options----{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Preview.Server- ( staticServer- ) where--import Control.Monad.Trans (liftIO)--import qualified Snap.Core as Snap-import qualified Snap.Http.Server as Snap-import qualified Snap.Util.FileServe as Snap---- | Serve a given directory----static :: FilePath -- ^ Directory to serve- -> (FilePath -> IO ()) -- ^ Pre-serve hook- -> Snap.Snap ()-static directory preServe =- Snap.serveDirectoryWith directoryConfig directory- where- directoryConfig :: Snap.DirectoryConfig Snap.Snap- directoryConfig = Snap.fancyDirectoryConfig- { Snap.preServeHook = liftIO . preServe- }---- | Main method, runs a static server in the given directory----staticServer :: FilePath -- ^ Directory to serve- -> (FilePath -> IO ()) -- ^ Pre-serve hook- -> Int -- ^ Port to listen on- -> IO () -- ^ Blocks forever-staticServer directory preServe port =- Snap.httpServe config $ static directory preServe- where- -- Snap server config- config = Snap.setPort port- $ Snap.setAccessLog Snap.ConfigNoLog- $ Snap.setErrorLog Snap.ConfigNoLog- $ Snap.emptyConfig
src/Hakyll/Web/Tags.hs view
@@ -1,11 +1,12 @@--- | Module containing some specialized functions to deal with tags.--- This Module follows certain conventions. My advice is to stick with them if--- possible.+--------------------------------------------------------------------------------+-- | This module containing some specialized functions to deal with tags. It+-- assumes you follow some conventions. ----- More concrete: all functions in this module assume that the tags are--- located in the @tags@ field, and separated by commas. An example file--- @foo.markdown@ could look like:+-- We support two types of tags: tags and categories. --+-- To use default tags, use 'buildTags'. Tags are placed in a comma-separated+-- metadata field like this:+-- -- > --- -- > author: Philip K. Dick -- > title: Do androids dream of electric sheep?@@ -14,150 +15,184 @@ -- > The novel is set in a post-apocalyptic near future, where the Earth and -- > its populations have been damaged greatly by Nuclear... ----- All the following functions would work with such a format. In addition to--- tags, Hakyll also supports categories. The convention when using categories--- is to place pages in subdirectories.+-- To use categories, use the 'buildCategories' function. Categories are+-- determined by the direcetory a page is in, for example, the post ----- An example, the page @posts\/coding\/2010-01-28-hakyll-categories.markdown@--- Tags or categories are read using the @readTags@ and @readCategory@--- functions. This module only provides functions to work with tags:--- categories are represented as tags. This is perfectly possible: categories--- only have an additional restriction that a page can only have one category--- (instead of multiple tags).+-- > posts/coding/2010-01-28-hakyll-categories.markdown ---{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, Arrows #-}+-- will receive the @coding@ category.+--+-- Advanced users may implement custom systems using 'buildTagsWith' if desired.+--+-- In the above example, we would want to create a page which lists all pages in+-- the @coding@ category, for example, with the 'Identifier':+--+-- > tags/coding.html+--+-- This is where the first parameter of 'buildTags' and 'buildCategories' comes+-- in. In the above case, we used the function:+--+-- > fromCapture "tags/*.html" :: String -> Identifier+--+-- The 'tagsRules' function lets you generate such a page for each tag in the+-- 'Rules' monad.+{-# LANGUAGE Arrows #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-} module Hakyll.Web.Tags- ( Tags (..)+ ( Tags , getTags- , readTagsWith- , readTags- , readCategory+ , buildTagsWith+ , buildTags+ , buildCategories+ , tagsRules , renderTagCloud , renderTagList- , renderTagsField- , renderTagsFieldWith- , renderCategoryField+ , tagsField+ , categoryField , sortTagsBy , caseInsensitiveTags ) where -import Prelude hiding (id)-import Control.Category (id)-import Control.Applicative ((<$>))-import Data.Char (toLower)-import Data.Ord (comparing)-import qualified Data.Map as M-import Data.List (intersperse, intercalate, sortBy)-import Control.Arrow (arr, (&&&), (>>>), (***), (<<^), returnA)-import Data.Maybe (catMaybes, fromMaybe)-import Data.Monoid (mconcat) -import Data.Typeable (Typeable)-import Data.Binary (Binary, get, put)-import Text.Blaze.Html.Renderer.String (renderHtml)-import Text.Blaze.Html ((!), toHtml, toValue)-import qualified Text.Blaze.Html5 as H-import qualified Text.Blaze.Html5.Attributes as A+--------------------------------------------------------------------------------+import Control.Arrow ((&&&))+import Control.Monad (foldM, forM, forM_)+import Data.Char (toLower)+import Data.List (intercalate, intersperse,+ sortBy)+import qualified Data.Map as M+import Data.Maybe (catMaybes, fromMaybe)+import Data.Monoid (mconcat)+import Data.Ord (comparing)+import System.FilePath (takeBaseName, takeDirectory)+import Text.Blaze.Html (toHtml, toValue, (!))+import Text.Blaze.Html.Renderer.String (renderHtml)+import qualified Text.Blaze.Html5 as H+import qualified Text.Blaze.Html5.Attributes as A -import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import Hakyll.Web.Urls-import Hakyll.Core.Writable-import Hakyll.Core.Identifier-import Hakyll.Core.Compiler-import Hakyll.Core.Util.String --- | Data about tags----data Tags a = Tags- { tagsMap :: [(String, [Page a])]- } deriving (Show, Typeable)+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Item+import Hakyll.Core.Metadata+import Hakyll.Core.Rules+import Hakyll.Core.Util.String+import Hakyll.Web.Template.Context+import Hakyll.Web.Html -instance Binary a => Binary (Tags a) where- get = Tags <$> get- put (Tags m) = put m -instance Writable (Tags a) where- write _ _ = return ()+--------------------------------------------------------------------------------+-- | Data about tags+data Tags = Tags+ { tagsMap :: [(String, [Identifier])]+ , tagsMakeId :: String -> Identifier+ , tagsDependency :: Dependency+ } deriving (Show) ++-------------------------------------------------------------------------------- -- | Obtain tags from a page in the default way: parse them from the @tags@ -- metadata field.----getTags :: Page a -> [String]-getTags = map trim . splitAll "," . getField "tags"+getTags :: MonadMetadata m => Identifier -> m [String]+getTags identifier = do+ metadata <- getMetadata identifier+ return $ maybe [] (map trim . splitAll ",") $ M.lookup "tags" metadata --- | Obtain categories from a page----getCategory :: Page a -> [String]-getCategory = return . getField "category"+--------------------------------------------------------------------------------+-- | Obtain categories from a page.+getCategory :: MonadMetadata m => Identifier -> m [String]+getCategory = return . return . takeBaseName . takeDirectory . toFilePath --- | Higher-level function to read tags----readTagsWith :: (Page a -> [String]) -- ^ Function extracting tags from a page- -> [Page a] -- ^ Pages- -> Tags a -- ^ Resulting tags-readTagsWith f pages = Tags- { tagsMap = M.toList $- foldl (M.unionWith (++)) M.empty (map readTagsWith' pages)- }++--------------------------------------------------------------------------------+-- | Higher-order function to read tags+buildTagsWith :: MonadMetadata m+ => (Identifier -> m [String])+ -> Pattern+ -> (String -> Identifier)+ -> m Tags+buildTagsWith f pattern makeId = do+ ids <- getMatches pattern+ tagMap <- foldM addTags M.empty ids+ return $ Tags (M.toList tagMap) makeId (PatternDependency pattern ids) where -- Create a tag map for one page- readTagsWith' page =- let tags = f page- in M.fromList $ zip tags $ repeat [page]+ addTags tagMap id' = do+ tags <- f id'+ let tagMap' = M.fromList $ zip tags $ repeat [id']+ return $ M.unionWith (++) tagMap tagMap' --- | Read a tagmap using the @tags@ metadata field----readTags :: [Page a] -> Tags a-readTags = readTagsWith getTags --- | Read a tagmap using the @category@ metadata field----readCategory :: [Page a] -> Tags a-readCategory = readTagsWith getCategory+--------------------------------------------------------------------------------+buildTags :: MonadMetadata m => Pattern -> (String -> Identifier) -> m Tags+buildTags = buildTagsWith getTags ++--------------------------------------------------------------------------------+buildCategories :: MonadMetadata m => Pattern -> (String -> Identifier)+ -> m Tags+buildCategories = buildTagsWith getCategory+++--------------------------------------------------------------------------------+tagsRules :: Tags -> (String -> Pattern -> Rules ()) -> Rules ()+tagsRules tags rules =+ forM_ (tagsMap tags) $ \(tag, identifiers) ->+ create [tagsMakeId tags tag] $+ rulesExtraDependencies [tagsDependency tags] $+ rules tag $ fromList identifiers+++-------------------------------------------------------------------------------- -- | Render tags in HTML----renderTags :: (String -> Identifier (Page a))- -- ^ Produce a link- -> (String -> String -> Int -> Int -> Int -> String)+renderTags :: (String -> String -> Int -> Int -> Int -> String) -- ^ Produce a tag item: tag, url, count, min count, max count -> ([String] -> String) -- ^ Join items- -> Compiler (Tags a) String+ -> Tags -- ^ Tag cloud renderer-renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do+ -> Compiler String+renderTags makeHtml concatHtml tags = do -- In tags' we create a list: [((tag, route), count)]- tags' <- mapCompiler ((id &&& (getRouteFor <<^ makeUrl)) *** arr length)- -< tags+ tags' <- forM (tagsMap tags) $ \(tag, ids) -> do+ route' <- getRoute $ tagsMakeId tags tag+ return ((tag, route'), length ids) + -- TODO: We actually need to tell a dependency here!+ let -- Absolute frequencies of the pages freqs = map snd tags' -- The minimum and maximum count found (min', max') | null freqs = (0, 1)- | otherwise = (minimum &&& maximum) freqs+ | otherwise = (minimum &&& maximum) freqs -- Create a link for one item- makeItem' ((tag, url), count) =- makeItem tag (toUrl $ fromMaybe "/" url) count min' max'+ makeHtml' ((tag, url), count) =+ makeHtml tag (toUrl $ fromMaybe "/" url) count min' max' -- Render and return the HTML- returnA -< concatItems $ map makeItem' tags'+ return $ concatHtml $ map makeHtml' tags' ++-------------------------------------------------------------------------------- -- | Render a tag cloud in HTML----renderTagCloud :: (String -> Identifier (Page a))- -- ^ Produce a link for a tag- -> Double+-- TODO: Maybe produce a Context here+renderTagCloud :: Double -- ^ Smallest font size, in percent -> Double -- ^ Biggest font size, in percent- -> Compiler (Tags a) String- -- ^ Tag cloud renderer-renderTagCloud makeUrl minSize maxSize =- renderTags makeUrl makeLink (intercalate " ")+ -> Tags+ -- ^ Input tags+ -> Compiler String+ -- ^ Rendered cloud+renderTagCloud minSize maxSize = renderTags makeLink (intercalate " ") where makeLink tag url count min' max' = renderHtml $ H.a ! A.style (toValue $ "font-size: " ++ size count min' max')@@ -171,61 +206,67 @@ size' = floor $ minSize + relative * (maxSize - minSize) in show (size' :: Int) ++ "%" ++-------------------------------------------------------------------------------- -- | Render a simple tag list in HTML, with the tag count next to the item----renderTagList :: (String -> Identifier (Page a)) -> Compiler (Tags a) (String)-renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ")+-- TODO: Maybe produce a Context here+renderTagList :: Tags -> Compiler (String)+renderTagList = renderTags makeLink (intercalate ", ") where makeLink tag url count _ _ = renderHtml $ H.a ! A.href (toValue url) $ toHtml (tag ++ " (" ++ show count ++ ")") ++-------------------------------------------------------------------------------- -- | Render tags with links with custom function to get tags. It is typically -- together with 'getTags' like this:--- +-- -- > renderTagsFieldWith (customFunction . getTags) -- > "tags" (fromCapture "tags/*")----renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags- -> String -- ^ Destination key- -> (String -> Identifier a) -- ^ Create a link for a tag- -> Compiler (Page a) (Page a) -- ^ Resulting compiler-renderTagsFieldWith tags destination makeUrl =- id &&& arr tags >>> setFieldA destination renderTags'- where- -- Compiler creating a comma-separated HTML string for a list of tags- renderTags' :: Compiler [String] String- renderTags' = arr (map $ id &&& makeUrl)- >>> mapCompiler (id *** getRouteFor)- >>> arr (map $ uncurry renderLink)- >>> arr (renderHtml . mconcat . intersperse ", " . catMaybes)+tagsFieldWith :: (Identifier -> Compiler [String]) -- ^ Get the tags+ -> String -- ^ Destination key+ -> Tags -- ^ Tags structure+ -> Context a -- ^ Resulting context+tagsFieldWith getTags' key tags = field key $ \item -> do+ tags' <- getTags' $ itemIdentifier item+ links <- forM tags' $ \tag -> do+ route' <- getRoute $ tagsMakeId tags tag+ return $ renderLink tag route' + return $ renderHtml $ mconcat $ intersperse ", " $ catMaybes $ links+ where -- Render one tag link renderLink _ Nothing = Nothing renderLink tag (Just filePath) = Just $ H.a ! A.href (toValue $ toUrl filePath) $ toHtml tag ++-------------------------------------------------------------------------------- -- | Render tags with links----renderTagsField :: String -- ^ Destination key- -> (String -> Identifier a) -- ^ Create a link for a tag- -> Compiler (Page a) (Page a) -- ^ Resulting compiler-renderTagsField = renderTagsFieldWith getTags+tagsField :: String -- ^ Destination key+ -> Tags -- ^ Tags+ -> Context a -- ^ Context+tagsField = tagsFieldWith getTags ++-------------------------------------------------------------------------------- -- | Render the category in a link----renderCategoryField :: String -- ^ Destination key- -> (String -> Identifier a) -- ^ Create a category link- -> Compiler (Page a) (Page a) -- ^ Resulting compiler-renderCategoryField = renderTagsFieldWith getCategory+categoryField :: String -- ^ Destination key+ -> Tags -- ^ Tags+ -> Context a -- ^ Context+categoryField = tagsFieldWith getCategory ++-------------------------------------------------------------------------------- -- | Sort tags using supplied function. First element of the tuple passed to -- the comparing function is the actual tag name.----sortTagsBy :: ((String, [Page a]) -> (String, [Page a]) -> Ordering)- -> Compiler (Tags a) (Tags a)-sortTagsBy f = arr $ Tags . sortBy f . tagsMap+sortTagsBy :: ((String, [Identifier]) -> (String, [Identifier]) -> Ordering)+ -> Tags -> Tags+sortTagsBy f t = t {tagsMap = sortBy f (tagsMap t)} ++-------------------------------------------------------------------------------- -- | Sample sorting function that compares tags case insensitively.----caseInsensitiveTags :: (String, [Page a]) -> (String, [Page a]) -> Ordering+caseInsensitiveTags :: (String, [Identifier]) -> (String, [Identifier])+ -> Ordering caseInsensitiveTags = comparing $ map toLower . fst
src/Hakyll/Web/Template.hs view
@@ -1,7 +1,7 @@ -- | This module provides means for reading and applying 'Template's. ----- Templates are tools to convert data (pages) into a string. They are--- perfectly suited for laying out your site.+-- Templates are tools to convert items into a string. They are perfectly suited+-- for laying out your site. -- -- Let's look at an example template: --@@ -22,9 +22,6 @@ -- > </body> -- > </html> ----- We can use this template to render a 'Page' which has a body and a @$title$@--- metadata field.--- -- As you can see, the format is very simple -- @$key$@ is used to render the -- @$key$@ field from the page, everything else is literally copied. If you want -- to literally insert @\"$key$\"@ into your page (for example, when you're@@ -36,115 +33,90 @@ -- -- Because of it's simplicity, these templates can be used for more than HTML: -- you could make, for example, CSS or JS templates as well.------ In addition to the native format, Hakyll also supports hamlet templates. For--- more information on hamlet templates, please refer to:--- <http://hackage.haskell.org/package/hamlet>. Internally, hamlet templates are--- converted to hakyll templates -- which means that you can only use variable--- insertion (and not all hamlet's features).------ This is an example of a valid hamlet template. You should place them in--- files with a @.hamlet@ extension:------ > !!!--- > <html>--- > <head>--- > <meta charset="UTF-8">--- > <title> MyAweSomeCompany - #{title}--- > <body>--- > <h1> MyAweSomeCompany - #{title}--- > <div id="navigation">--- > <a href="/index.html"> Home--- > <a href="/about.html"> About--- > <a href="/code.html"> Code--- > #{body}--- module Hakyll.Web.Template ( Template+ , templateCompiler , applyTemplate+ , loadAndApplyTemplate+ , applyAsTemplate , applyTemplateWith- , applySelf- , templateCompiler- , templateCompilerWith- , applyTemplateCompiler- , applyTemplateCompilerWith ) where -import Control.Arrow-import Data.Maybe (fromMaybe)-import System.FilePath (takeExtension)-import qualified Data.Map as M -import Text.Hamlet (HamletSettings, defaultHamletSettings)+--------------------------------------------------------------------------------+import Control.Monad (forM, liftM)+import Data.Monoid (mappend)+import Prelude hiding (id) -import Hakyll.Core.Compiler-import Hakyll.Core.Identifier-import Hakyll.Core.Resource-import Hakyll.Web.Template.Internal-import Hakyll.Web.Template.Read-import Hakyll.Web.Page.Internal --- | Substitutes @$identifiers@ in the given @Template@ by values from the given--- "Page". When a key is not found, it is left as it is.----applyTemplate :: Template -> Page String -> Page String-applyTemplate = applyTemplateWith defaultMissingHandler+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Web.Template.Context+import Hakyll.Web.Template.Internal+import Hakyll.Web.Template.Read --- | Default solution if a key is missing: render it again-defaultMissingHandler :: String -> String-defaultMissingHandler k = "$" ++ k ++ "$" --- | A version of 'applyTemplate' which allows you to give a fallback option,--- which can produce the value for a key if it is missing.----applyTemplateWith :: (String -> String) -- ^ Fallback if key missing- -> Template -- ^ Template to apply- -> Page String -- ^ Input page- -> Page String -- ^ Resulting page-applyTemplateWith missing template page =- fmap (const $ substitute =<< unTemplate template) page- where- map' = toMap page- substitute (Chunk chunk) = chunk- substitute (Key key) = fromMaybe (missing key) $ M.lookup key map'- substitute (Escaped) = "$"+--------------------------------------------------------------------------------+-- | Read a template.+templateCompiler :: Compiler (Item Template)+templateCompiler = cached "Hakyll.Web.Template.templateCompiler" $ do+ item <- getResourceString+ return $ fmap readTemplate item --- | Apply a page as it's own template. This is often very useful to fill in--- certain keys like @$root@ and @$url@.----applySelf :: Page String -> Page String-applySelf page = applyTemplate (readTemplate $ pageBody page) page --- | Read a template. If the extension of the file we're compiling is--- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed--- as such.----templateCompiler :: Compiler Resource Template-templateCompiler = templateCompilerWith defaultHamletSettings+--------------------------------------------------------------------------------+applyTemplate :: Template -- ^ Template+ -> Context a -- ^ Context+ -> Item a -- ^ Page+ -> Compiler (Item String) -- ^ Resulting item+applyTemplate tpl context item = do+ -- Appending missingField gives better error messages+ let context' k x = unContext (context `mappend` missingField) k x+ body <- applyTemplateWith context' tpl item+ return $ itemSetBody body item --- | Version of 'templateCompiler' that enables custom settings.++--------------------------------------------------------------------------------+-- | The following pattern is so common: ---templateCompilerWith :: HamletSettings -> Compiler Resource Template-templateCompilerWith settings =- cached "Hakyll.Web.Template.templateCompilerWith" $- getIdentifier &&& getResourceString >>^ uncurry read'- where- read' identifier string =- if takeExtension (toFilePath identifier) `elem` [".hml", ".hamlet"]- -- Hamlet template- then readHamletTemplateWith settings string- -- Hakyll template- else readTemplate string+-- > tpl <- loadBody "templates/foo.html"+-- > someCompiler+-- > >>= applyTemplate tpl context+--+-- That we have a single function which does this:+--+-- > someCompiler+-- > >>= loadAndApplyTemplate "templates/foo.html" context+loadAndApplyTemplate :: Identifier -- ^ Template identifier+ -> Context a -- ^ Context+ -> Item a -- ^ Page+ -> Compiler (Item String) -- ^ Resulting item+loadAndApplyTemplate identifier context item = do+ tpl <- loadBody identifier+ applyTemplate tpl context item -applyTemplateCompiler :: Identifier Template -- ^ Template- -> Compiler (Page String) (Page String) -- ^ Compiler-applyTemplateCompiler = applyTemplateCompilerWith defaultMissingHandler --- | A version of 'applyTemplateCompiler' which allows you to pass a function--- which is called for a key when it is missing.----applyTemplateCompilerWith :: (String -> String)- -> Identifier Template- -> Compiler (Page String) (Page String)-applyTemplateCompilerWith missing identifier =- require identifier (flip $ applyTemplateWith missing)+--------------------------------------------------------------------------------+-- | It is also possible that you want to substitute @$key$@s within the body of+-- an item. This function does that by interpreting the item body as a template,+-- and then applying it to itself.+applyAsTemplate :: Context String -- ^ Context+ -> Item String -- ^ Item and template+ -> Compiler (Item String) -- ^ Resulting item+applyAsTemplate context item =+ let tpl = readTemplate $ itemBody item+ in applyTemplate tpl context item+++--------------------------------------------------------------------------------+-- | Overloaded apply template function to work in an arbitrary Monad.+applyTemplateWith :: Monad m+ => (String -> a -> m String)+ -> Template -> a -> m String+applyTemplateWith context tpl x = liftM concat $+ forM (unTemplate tpl) $ \e -> case e of+ Chunk c -> return c+ Escaped -> return "$"+ Key k -> context k x
+ src/Hakyll/Web/Template/Context.hs view
@@ -0,0 +1,219 @@+--------------------------------------------------------------------------------+module Hakyll.Web.Template.Context+ ( Context (..)+ , mapContext+ , field+ , constField+ , functionField++ , defaultContext+ , bodyField+ , metadataField+ , urlField+ , pathField+ , titleField+ , dateField+ , dateFieldWith+ , getItemUTC+ , modificationTimeField+ , modificationTimeFieldWith+ , missingField+ ) where+++--------------------------------------------------------------------------------+import Control.Applicative (Alternative (..), (<$>))+import Control.Monad (msum)+import Data.List (intercalate)+import qualified Data.Map as M+import Data.Monoid (Monoid (..))+import Data.Time.Clock (UTCTime (..))+import Data.Time.Format (formatTime, parseTime)+import System.FilePath (takeBaseName, takeFileName)+import System.Locale (TimeLocale, defaultTimeLocale)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Core.Metadata+import Hakyll.Core.Provider+import Hakyll.Core.Util.String (splitAll)+import Hakyll.Web.Html+++--------------------------------------------------------------------------------+newtype Context a = Context+ { unContext :: String -> Item a -> Compiler String+ }+++--------------------------------------------------------------------------------+instance Monoid (Context a) where+ mempty = missingField+ mappend (Context f) (Context g) = Context $ \k i -> f k i <|> g k i+++--------------------------------------------------------------------------------+mapContext :: (String -> String) -> Context a -> Context a+mapContext f (Context g) = Context $ \k i -> f <$> g k i+++--------------------------------------------------------------------------------+field :: String -> (Item a -> Compiler String) -> Context a+field key value = Context $ \k i -> if k == key then value i else empty+++--------------------------------------------------------------------------------+constField :: String -> String -> Context a+constField key = field key . const . return+++--------------------------------------------------------------------------------+functionField :: String -> ([String] -> Item a -> Compiler String) -> Context a+functionField name value = Context $ \k i -> case words k of+ [] -> empty+ (n : args)+ | n == name -> value args i+ | otherwise -> empty+++--------------------------------------------------------------------------------+defaultContext :: Context String+defaultContext =+ bodyField "body" `mappend`+ metadataField `mappend`+ urlField "url" `mappend`+ pathField "path" `mappend`+ titleField "title" `mappend`+ missingField+++--------------------------------------------------------------------------------+bodyField :: String -> Context String+bodyField key = field key $ return . itemBody+++--------------------------------------------------------------------------------+-- | Map any field to its metadata value, if present+metadataField :: Context String+metadataField = Context $ \k i -> do+ metadata <- getMetadata $ itemIdentifier i+ maybe empty return $ M.lookup k metadata+++--------------------------------------------------------------------------------+-- | Absolute url to the resulting item+urlField :: String -> Context a+urlField key = field key $+ fmap (maybe empty toUrl) . getRoute . itemIdentifier+++--------------------------------------------------------------------------------+-- | Filepath of the underlying file of the item+pathField :: String -> Context a+pathField key = field key $ return . toFilePath . itemIdentifier+++--------------------------------------------------------------------------------+-- | This title field takes the basename of the underlying file by default+titleField :: String -> Context a+titleField key = mapContext takeBaseName $ pathField key+++--------------------------------------------------------------------------------+-- | When the metadata has a field called @published@ in one of the+-- following formats then this function can render the date.+--+-- * @Sun, 01 Feb 2000 13:00:00 UT@ (RSS date format)+--+-- * @2000-02-01T13:00:00Z@ (Atom date format)+--+-- * @February 1, 2000 1:00 PM@ (PM is usually uppercase)+--+-- * @February 1, 2000@ (assumes 12:00 AM for the time)+--+-- Alternatively, when the metadata has a field called @path@ in a+-- @folder/yyyy-mm-dd-title.extension@ format (the convention for pages)+-- and no @published@ metadata field set, this function can render+-- the date.+--+-- > renderDateField "date" "%B %e, %Y" "Date unknown"+--+-- Will render something like @January 32, 2010@.+--+dateField :: String -- ^ Key in which the rendered date should be placed+ -> String -- ^ Format to use on the date+ -> Context a -- ^ Resulting context+dateField = dateFieldWith defaultTimeLocale+++--------------------------------------------------------------------------------+-- | This is an extended version of 'dateField' that allows you to+-- specify a time locale that is used for outputting the date. For more+-- details, see 'dateField'.+dateFieldWith :: TimeLocale -- ^ Output time locale+ -> String -- ^ Destination key+ -> String -- ^ Format to use on the date+ -> Context a -- ^ Resulting context+dateFieldWith locale key format = field key $ \i -> do+ time <- getItemUTC locale $ itemIdentifier i+ return $ formatTime locale format time+++--------------------------------------------------------------------------------+-- | Parser to try to extract and parse the time from the @published@+-- field or from the filename. See 'renderDateField' for more information.+-- Exported for user convenience.+getItemUTC :: TimeLocale -- ^ Output time locale+ -> Identifier -- ^ Input page+ -> Compiler UTCTime -- ^ Parsed UTCTime+getItemUTC locale id' = do+ metadata <- getMetadata id'+ let tryField k fmt = M.lookup k metadata >>= parseTime' fmt+ fn = takeFileName $ toFilePath id'++ maybe empty' return $ msum $+ [tryField "published" fmt | fmt <- formats] +++ [tryField "date" fmt | fmt <- formats] +++ [parseTime' "%Y-%m-%d" $ intercalate "-" $ take 3 $ splitAll "-" fn]+ where+ empty' = compilerThrow $ "Hakyll.Web.Template.Context.getItemUTC: " +++ "could not parse time for " ++ show id'+ parseTime' = parseTime locale+ formats =+ [ "%a, %d %b %Y %H:%M:%S UT"+ , "%Y-%m-%dT%H:%M:%SZ"+ , "%Y-%m-%d %H:%M:%S"+ , "%Y-%m-%d"+ , "%B %e, %Y %l:%M %p"+ , "%B %e, %Y"+ ]+++--------------------------------------------------------------------------------+modificationTimeField :: String -- ^ Key+ -> String -- ^ Format+ -> Context a -- ^ Resuting context+modificationTimeField = modificationTimeFieldWith defaultTimeLocale+++--------------------------------------------------------------------------------+modificationTimeFieldWith :: TimeLocale -- ^ Time output locale+ -> String -- ^ Key+ -> String -- ^ Format+ -> Context a -- ^ Resulting context+modificationTimeFieldWith locale key fmt = field key $ \i -> do+ provider <- compilerProvider <$> compilerAsk+ mtime <- compilerUnsafeIO $+ resourceModificationTime provider $ itemIdentifier i+ return $ formatTime locale fmt mtime+++--------------------------------------------------------------------------------+missingField :: Context a+missingField = Context $ \k i -> compilerThrow $+ "Missing field $" ++ k ++ "$ in context for item " +++ show (itemIdentifier i)
src/Hakyll/Web/Template/Internal.hs view
@@ -1,37 +1,47 @@+-------------------------------------------------------------------------------- -- | Module containing the template data structure----{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Hakyll.Web.Template.Internal ( Template (..) , TemplateElement (..) ) where -import Control.Applicative ((<$>)) -import Data.Binary (Binary, get, getWord8, put, putWord8)-import Data.Typeable (Typeable)+--------------------------------------------------------------------------------+import Control.Applicative ((<$>))+import Data.Binary (Binary, get, getWord8, put, putWord8)+import Data.Typeable (Typeable) -import Hakyll.Core.Writable +--------------------------------------------------------------------------------+import Hakyll.Core.Writable+++-------------------------------------------------------------------------------- -- | Datatype used for template substitutions.--- newtype Template = Template { unTemplate :: [TemplateElement] } deriving (Show, Eq, Binary, Typeable) ++-------------------------------------------------------------------------------- instance Writable Template where -- Writing a template is impossible write _ _ = return () ++-------------------------------------------------------------------------------- -- | Elements of a template.--- data TemplateElement = Chunk String | Key String | Escaped deriving (Show, Eq, Typeable) ++-------------------------------------------------------------------------------- instance Binary TemplateElement where put (Chunk string) = putWord8 0 >> put string put (Key key) = putWord8 1 >> put key
+ src/Hakyll/Web/Template/List.hs view
@@ -0,0 +1,66 @@+--------------------------------------------------------------------------------+-- | Provides an easy way to combine several items in a list. The applications+-- are obvious:+--+-- * A post list on a blog+--+-- * An image list in a gallery+--+-- * A sitemap+module Hakyll.Web.Template.List+ ( applyTemplateList+ , applyJoinTemplateList+ , chronological+ , recentFirst+ ) where+++--------------------------------------------------------------------------------+import Data.List (intersperse, sortBy)+import Data.Ord (comparing)+import System.FilePath (takeBaseName)+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Identifier+import Hakyll.Core.Item+import Hakyll.Web.Template+import Hakyll.Web.Template.Context+++--------------------------------------------------------------------------------+-- | Generate a string of a listing of pages, after applying a template to each+-- page.+applyTemplateList :: Template+ -> Context a+ -> [Item a]+ -> Compiler String+applyTemplateList = applyJoinTemplateList ""+++--------------------------------------------------------------------------------+-- | Join a listing of pages with a string in between, after applying a template+-- to each page.+applyJoinTemplateList :: String+ -> Template+ -> Context a+ -> [Item a]+ -> Compiler String+applyJoinTemplateList delimiter tpl context items = do+ items' <- mapM (applyTemplate tpl context) items+ return $ concat $ intersperse delimiter $ map itemBody items'+++--------------------------------------------------------------------------------+-- | Sort pages chronologically. This function assumes that the pages have a+-- @year-month-day-title.extension@ naming scheme -- as is the convention in+-- Hakyll.+chronological :: [Item a] -> [Item a]+chronological = sortBy $ comparing $ takeBaseName . toFilePath . itemIdentifier+++--------------------------------------------------------------------------------+-- | The reverse of 'chronological'+recentFirst :: [Item a] -> [Item a]+recentFirst = reverse . chronological
src/Hakyll/Web/Template/Read.hs view
@@ -1,10 +1,41 @@--- | Re-exports all different template reading modules---+--------------------------------------------------------------------------------+-- | Read templates in Hakyll's native format module Hakyll.Web.Template.Read ( readTemplate- , readHamletTemplate- , readHamletTemplateWith ) where -import Hakyll.Web.Template.Read.Hakyll-import Hakyll.Web.Template.Read.Hamlet++--------------------------------------------------------------------------------+import Data.List (isPrefixOf)+++--------------------------------------------------------------------------------+import Hakyll.Web.Template.Internal+++--------------------------------------------------------------------------------+-- | Construct a @Template@ from a string.+readTemplate :: String -> Template+readTemplate = Template . readTemplate'+ where+ readTemplate' [] = []+ readTemplate' string+ | "$$" `isPrefixOf` string =+ Escaped : readTemplate' (drop 2 string)+ | "$" `isPrefixOf` string =+ case readKey (drop 1 string) of+ Just (key, rest) -> Key key : readTemplate' rest+ Nothing -> Chunk "$" : readTemplate' (drop 1 string)+ | otherwise =+ let (chunk, rest) = break (== '$') string+ in Chunk chunk : readTemplate' rest++ -- Parse an key into (key, rest) if it's valid, and return+ -- Nothing otherwise+ readKey string =+ let (key, rest) = span validKeyChar string+ in if not (null key) && "$" `isPrefixOf` rest+ then Just (key, drop 1 rest)+ else Nothing++ validKeyChar x = x `notElem` ['$', '\n', '\r']
− src/Hakyll/Web/Template/Read/Hakyll.hs
@@ -1,35 +0,0 @@--- | Read templates in Hakyll's native format----module Hakyll.Web.Template.Read.Hakyll- ( readTemplate- ) where--import Data.List (isPrefixOf)-import Data.Char (isAlphaNum)--import Hakyll.Web.Template.Internal---- | Construct a @Template@ from a string.----readTemplate :: String -> Template-readTemplate = Template . readTemplate'- where- readTemplate' [] = []- readTemplate' string- | "$$" `isPrefixOf` string =- Escaped : readTemplate' (drop 2 string)- | "$" `isPrefixOf` string =- case readKey (drop 1 string) of- Just (key, rest) -> Key key : readTemplate' rest- Nothing -> Chunk "$" : readTemplate' (drop 1 string)- | otherwise =- let (chunk, rest) = break (== '$') string- in Chunk chunk : readTemplate' rest-- -- Parse an key into (key, rest) if it's valid, and return- -- Nothing otherwise- readKey string =- let (key, rest) = span isAlphaNum string- in if not (null key) && "$" `isPrefixOf` rest- then Just (key, drop 1 rest)- else Nothing
− src/Hakyll/Web/Template/Read/Hamlet.hs
@@ -1,46 +0,0 @@--- | Read templates in the hamlet format----{-# LANGUAGE MultiParamTypeClasses #-}-module Hakyll.Web.Template.Read.Hamlet- ( readHamletTemplate- , readHamletTemplateWith- ) where--import Text.Hamlet (HamletSettings, defaultHamletSettings)-import Text.Hamlet.RT--import Hakyll.Web.Template.Internal---- | Read a hamlet template using the default settings----readHamletTemplate :: String -> Template-readHamletTemplate = readHamletTemplateWith defaultHamletSettings---- | Read a hamlet template using the specified settings----readHamletTemplateWith :: HamletSettings -> String -> Template-readHamletTemplateWith settings string =- let result = parseHamletRT settings string- in case result of- Just hamlet -> fromHamletRT hamlet- Nothing -> error- "Hakyll.Web.Template.Read.Hamlet.readHamletTemplateWith: \- \Could not parse Hamlet file"---- | Convert a 'HamletRT' to a 'Template'----fromHamletRT :: HamletRT -- ^ Hamlet runtime template- -> Template -- ^ Hakyll template-fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd- where- fromSimpleDoc :: SimpleDoc -> TemplateElement- fromSimpleDoc (SDRaw chunk) = Chunk chunk- fromSimpleDoc (SDVar [var]) = Key var- fromSimpleDoc (SDVar _) = error- "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \- \Hakyll does not support '.' in identifier names when using \- \hamlet templates."- fromSimpleDoc _ = error- "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \- \Only simple $key$ identifiers are allowed when using hamlet \- \templates."
− src/Hakyll/Web/Urls.hs
@@ -1,66 +0,0 @@--- | Provides utilities to manipulate URL's----module Hakyll.Web.Urls- ( withUrls- , toUrl- , toSiteRoot- , isExternal- ) where--import Data.List (isPrefixOf)-import Data.Char (toLower)-import System.FilePath (splitPath, takeDirectory, joinPath)-import qualified Data.Set as S--import qualified Text.HTML.TagSoup as TS---- | Apply a function to each URL on a webpage----withUrls :: (String -> String) -> String -> String-withUrls f = renderTags' . map tag . TS.parseTags- where- tag (TS.TagOpen s a) = TS.TagOpen s $ map attr a- tag x = x- attr (k, v) = (k, if k `S.member` refs then f v else v)- refs = S.fromList ["src", "href"]---- | Customized TagSoup renderer. (The default TagSoup renderer escape CSS--- within style tags.)----renderTags' :: [TS.Tag String] -> String-renderTags' = TS.renderTagsOptions TS.renderOptions- { TS.optRawTag = (`elem` ["script", "style"]) . map toLower- , TS.optMinimize = (`elem` ["br", "img"])- }---- | Convert a filepath to an URL starting from the site root------ Example:------ > toUrl "foo/bar.html"------ Result:------ > "/foo/bar.html"----toUrl :: FilePath -> String-toUrl ('/' : xs) = '/' : xs-toUrl url = '/' : url---- | Get the relative url to the site root, for a given (absolute) url----toSiteRoot :: String -> String-toSiteRoot = emptyException . joinPath . map parent- . filter relevant . splitPath . takeDirectory- where- parent = const ".."- emptyException [] = "."- emptyException x = x- relevant "." = False- relevant "/" = False- relevant _ = True---- | Check if an URL links to an external HTTP(S) source----isExternal :: String -> Bool-isExternal url = any (flip isPrefixOf url) ["http://", "https://"]
− src/Hakyll/Web/Urls/Relativize.hs
@@ -1,48 +0,0 @@--- | This module exposes a function which can relativize URL's on a webpage.------ This means that one can deploy the resulting site on--- @http:\/\/example.com\/@, but also on @http:\/\/example.com\/some-folder\/@--- without having to change anything (simply copy over the files).------ To use it, you should use absolute URL's from the site root everywhere. For--- example, use------ > <img src="/images/lolcat.png" alt="Funny zomgroflcopter" />------ in a blogpost. When running this through the relativize URL's module, this--- will result in (suppose your blogpost is located at @\/posts\/foo.html@:------ > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />----module Hakyll.Web.Urls.Relativize- ( relativizeUrlsCompiler- , relativizeUrls- ) where--import Prelude hiding (id)-import Control.Category (id)-import Control.Arrow ((&&&), (>>^))-import Data.List (isPrefixOf)--import Hakyll.Core.Compiler-import Hakyll.Web.Page-import Hakyll.Web.Urls---- | Compiler form of 'relativizeUrls' which automatically picks the right root--- path----relativizeUrlsCompiler :: Compiler (Page String) (Page String)-relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize- where- relativize Nothing = id- relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)---- | Relativize URL's in HTML----relativizeUrls :: String -- ^ Path to the site root- -> String -- ^ HTML to relativize- -> String -- ^ Resulting HTML-relativizeUrls root = withUrls rel- where- isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)- rel x = if isRel x then root ++ x else x
− src/Hakyll/Web/Util/Html.hs
@@ -1,47 +0,0 @@--- | Miscellaneous HTML manipulation functions----module Hakyll.Web.Util.Html- ( stripTags- , escapeHtml- ) where--import Text.Blaze.Html (toHtml)-import Text.Blaze.Html.Renderer.String (renderHtml)---- | Strip all HTML tags from a string------ Example:------ > stripTags "<p>foo</p>"------ Result:------ > "foo"------ This also works for incomplete tags------ Example:------ > stripTags "<p>foo</p"------ Result:------ > "foo"----stripTags :: String -> String-stripTags [] = []-stripTags ('<' : xs) = stripTags $ drop 1 $ dropWhile (/= '>') xs-stripTags (x : xs) = x : stripTags xs---- | HTML-escape a string------ Example:------ > escapeHtml "Me & Dean"------ Result:------ > "Me & Dean"----escapeHtml :: String -> String-escapeHtml = renderHtml . toHtml
− tests/Hakyll/Core/Compiler/Tests.hs
@@ -1,36 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Core.Compiler.Tests- ( tests- ) where--import qualified Data.Map as M--import Test.Framework (Test)-import Test.Framework.Providers.HUnit (testCase)-import qualified Test.HUnit as H--import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.Util.Arrow-import TestSuite.Util--tests :: [Test]-tests =- [ testCase "byExtension" byExtensionTest- ]--byExtensionTest :: H.Assertion-byExtensionTest = do- provider <- dummyResourceProvider $ M.empty- txt <- runCompilerJobTest compiler "foo.txt" provider uni- css <- runCompilerJobTest compiler "bar.css" provider uni- html <- runCompilerJobTest compiler "qux.html" provider uni- H.assertEqual "byExtension" "txt" txt- H.assertEqual "byExtension" "css" css- H.assertEqual "byExtension" "unknown" html- where- uni = ["foo.txt", "bar.css", "qux.html"]- compiler = byExtension (constA ("unknown" :: String))- [ (".txt", constA "txt")- , (".css", constA "css")- ]
+ tests/Hakyll/Core/Dependencies/Tests.hs view
@@ -0,0 +1,70 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Dependencies.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Data.List (delete)+import qualified Data.Map as M+import qualified Data.Set as S+import Test.Framework (Test, testGroup)+import Test.HUnit (Assertion, (@=?))+++--------------------------------------------------------------------------------+import Hakyll.Core.Dependencies+import Hakyll.Core.Identifier+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Dependencies.Tests" $+ fromAssertions "analyze" [case01, case02, case03]+++--------------------------------------------------------------------------------+oldUniverse :: [Identifier]+oldUniverse = M.keys oldFacts+++--------------------------------------------------------------------------------+oldFacts :: DependencyFacts+oldFacts = M.fromList+ [ ("posts/01.md",+ [])+ , ("posts/02.md",+ [])+ , ("index.md",+ [ PatternDependency "posts/*" ["posts/01.md", "posts/02.md"]+ , IdentifierDependency "posts/01.md"+ , IdentifierDependency "posts/02.md"+ ])+ ]+++--------------------------------------------------------------------------------+-- | posts/02.md has changed+case01 :: Assertion+case01 = S.fromList ["posts/02.md", "index.md"] @=? ood+ where+ (ood, _, _) = outOfDate oldUniverse (S.singleton "posts/02.md") oldFacts+++--------------------------------------------------------------------------------+-- | about.md was added+case02 :: Assertion+case02 = S.singleton "about.md" @=? ood+ where+ (ood, _, _) = outOfDate ("about.md" : oldUniverse) S.empty oldFacts+++--------------------------------------------------------------------------------+-- | posts/01.md was removed+case03 :: Assertion+case03 = S.singleton "index.md" @=? ood+ where+ (ood, _, _) =+ outOfDate ("posts/01.md" `delete` oldUniverse) S.empty oldFacts
− tests/Hakyll/Core/DependencyAnalyzer/Tests.hs
@@ -1,70 +0,0 @@-module Hakyll.Core.DependencyAnalyzer.Tests where--import Control.Arrow (second)-import qualified Data.Set as S-import Data.Monoid (mempty)--import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)--import Hakyll.Core.DirectedGraph-import Hakyll.Core.DependencyAnalyzer--tests :: [Test]-tests =- [ testCase "step [1]" step1- , testCase "step [2]" step2- ]--step1 :: Assertion-step1 = Just (S.fromList [1, 2, 5, 6, 7, 8, 9]) @?=- stepAll (makeDependencyAnalyzer graph isOutOfDate prev)- where- node = curry $ second S.fromList-- graph = fromList- [ node (8 :: Int) [2, 4, 6]- , node 2 [4, 3]- , node 4 [3]- , node 6 [4]- , node 3 []- , node 9 [5]- , node 5 [7]- , node 1 [7]- , node 7 []- ]-- prev = fromList- [ node 8 [2, 4, 6]- , node 2 [4, 3]- , node 4 [3]- , node 6 [4]- , node 3 []- , node 9 [5]- , node 5 [7]- , node 1 [7]- , node 7 [8]- ]-- isOutOfDate = (`elem` [5, 2, 6])--step2 :: Assertion-step2 = Nothing @?= stepAll (makeDependencyAnalyzer graph isOutOfDate mempty)- where- node = curry $ second S.fromList-- -- Cycle: 4 -> 7 -> 5 -> 9 -> 4- graph = fromList- [ node (1 :: Int) [6]- , node 2 [3]- , node 3 []- , node 4 [1, 7, 8]- , node 5 [9]- , node 6 [3]- , node 7 [5]- , node 8 [2]- , node 9 [4]- ]-- isOutOfDate = const True
tests/Hakyll/Core/Identifier/Tests.hs view
@@ -1,21 +1,30 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Identifier.Tests ( tests ) where -import Test.Framework-import Test.HUnit hiding (Test) -import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import TestSuite.Util+--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.HUnit ((@=?)) -tests :: [Test]-tests = concat++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Identifier.Tests" $ concat [ captureTests , matchesTests ] ++-------------------------------------------------------------------------------- captureTests :: [Test] captureTests = fromAssertions "capture" [ Just ["bar"] @=? capture "foo/**" "foo/bar"@@ -35,12 +44,17 @@ , Nothing @=? capture "\\*.jpg" "foo.jpg" ] ++-------------------------------------------------------------------------------- matchesTests :: [Test] matchesTests = fromAssertions "matches"- [ True @=? matches (list ["foo.markdown"]) "foo.markdown"- , False @=? matches (list ["foo"]) (Identifier (Just "foo") "foo")- , True @=? matches (regex "^foo/[^x]*$") "foo/bar"- , False @=? matches (regex "^foo/[^x]*$") "foo/barx"+ [ True @=? matches (fromList ["foo.markdown"]) "foo.markdown"+ , False @=? matches (fromList ["foo"]) (setVersion (Just "x") "foo")+ , True @=? matches (fromVersion (Just "xz")) (setVersion (Just "xz") "bar")+ , True @=? matches (fromRegex "^foo/[^x]*$") "foo/bar"+ , False @=? matches (fromRegex "^foo/[^x]*$") "foo/barx" , True @=? matches (complement "foo.markdown") "bar.markdown" , False @=? matches (complement "foo.markdown") "foo.markdown"+ , True @=? matches ("foo" .||. "bar") "bar"+ , False @=? matches ("bar" .&&. hasNoVersion) (setVersion (Just "xz") "bar") ]
+ tests/Hakyll/Core/Provider/Tests.hs view
@@ -0,0 +1,39 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Provider.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import qualified Data.Map as M+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, assert, (@=?))+++--------------------------------------------------------------------------------+import Hakyll.Core.Provider+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Provider.Tests"+ [ testCase "case01" case01+ ]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = do+ store <- newTestStore+ provider <- newTestProvider store+ assert $ resourceExists provider "example.md"++ metadata <- resourceMetadata provider "example.md"+ Just "An example" @=? M.lookup "title" metadata+ Just "External data" @=? M.lookup "external" metadata++ doesntExist <- resourceMetadata provider "doesntexist.md"+ M.empty @=? doesntExist
tests/Hakyll/Core/Routes/Tests.hs view
@@ -1,17 +1,24 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.Routes.Tests ( tests ) where -import Test.Framework-import Test.HUnit hiding (Test) -import Hakyll.Core.Identifier-import Hakyll.Core.Routes-import TestSuite.Util+--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.HUnit ((@=?)) -tests :: [Test]-tests = fromAssertions "runRoutes"++--------------------------------------------------------------------------------+import Hakyll.Core.Identifier+import Hakyll.Core.Routes+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Routes.Tests" $ fromAssertions "runRoutes" [ Just "foo.html" @=? runRoutes (setExtension "html") "foo" , Just "foo.html" @=? runRoutes (setExtension ".html") "foo" , Just "foo.html" @=? runRoutes (setExtension "html") "foo.markdown"
tests/Hakyll/Core/Rules/Tests.hs view
@@ -1,78 +1,93 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} module Hakyll.Core.Rules.Tests ( tests ) where -import qualified Data.Map as M-import qualified Data.Set as S -import Test.Framework-import Test.HUnit hiding (Test)+--------------------------------------------------------------------------------+import Data.IORef (IORef, newIORef, readIORef,+ writeIORef)+import qualified Data.Set as S+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, assert, (@=?)) -import Hakyll.Core.Rules-import Hakyll.Core.Rules.Internal-import Hakyll.Core.Identifier-import Hakyll.Core.Identifier.Pattern-import Hakyll.Core.Routes-import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.Writable.CopyFile-import Hakyll.Web.Page-import TestSuite.Util -tests :: [Test]-tests = fromAssertions "runRules" [case01]+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.File+import Hakyll.Core.Identifier+import Hakyll.Core.Identifier.Pattern+import Hakyll.Core.Routes+import Hakyll.Core.Rules+import Hakyll.Core.Rules.Internal+import Hakyll.Web.Pandoc+import TestSuite.Util --- | Dummy resource provider----provider :: IO ResourceProvider-provider = dummyResourceProvider $ M.fromList $ map (flip (,) "No content")- [ "posts/a-post.markdown"- , "posts/some-other-post.markdown"++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Rules.Tests"+ [ testCase "runRules" rulesTest ] --- | Main test----case01 :: Assertion-case01 = do- p <- provider- let ruleSet = runRules rules p- identifiers = map fst $ rulesCompilers ruleSet++--------------------------------------------------------------------------------+rulesTest :: Assertion+rulesTest = do+ ioref <- newIORef False+ store <- newTestStore+ provider <- newTestProvider store+ ruleSet <- runRules (rules ioref) provider+ let identifiers = S.fromList $ map fst $ rulesCompilers ruleSet routes = rulesRoutes ruleSet- expected @=? S.fromList identifiers- Just "posts/a-post.markdown" @=?- runRoutes routes (Identifier (Just "nav") "posts/a-post.markdown")++ -- Test that we have some identifiers and that the routes work out+ assert $ all (`S.member` identifiers) expected+ Just "example.html" @=? runRoutes routes "example.md"+ Just "example.md" @=? runRoutes routes (sv "raw" "example.md")+ Just "example.md" @=? runRoutes routes (sv "nav" "example.md")+ Just "example.mv1" @=? runRoutes routes (sv "mv1" "example.md")+ Just "example.mv2" @=? runRoutes routes (sv "mv2" "example.md")+ readIORef ioref >>= assert where- expected = S.fromList- [ Identifier Nothing "posts/a-post.markdown"- , Identifier Nothing "posts/some-other-post.markdown"- , Identifier (Just "raw") "posts/a-post.markdown"- , Identifier (Just "raw") "posts/some-other-post.markdown"- , Identifier (Just "nav") "posts/a-post.markdown"+ sv g = setVersion (Just g)+ expected =+ [ "example.md"+ , "russian.md"+ , sv "raw" "example.md"+ , sv "raw" "russian.md"+ , sv "nav" "example.md" ] --- | Example rules----rules :: Rules-rules = do++--------------------------------------------------------------------------------+rules :: IORef Bool -> Rules ()+rules ioref = do -- Compile some posts- match "posts/*" $ do+ match "*.md" $ do route $ setExtension "html"- compile pageCompiler+ compile pandocCompiler + -- Yeah. I don't know how else to test this stuff?+ preprocess $ writeIORef ioref True+ -- Compile them, raw- group "raw" $ do+ match "*.md" $ version "raw" $ do route idRoute- match "posts/*" $ do- route $ setExtension "html"- compile getResourceString+ compile getResourceString -- Regression test- group "nav" $ do- match (list ["posts/a-post.markdown"]) $ do- route idRoute- compile copyFileCompiler+ version "nav" $ match (fromList ["example.md"]) $ do+ route idRoute+ compile copyFileCompiler - return ()+ -- Another edge case: different versions in one match+ match "*.md" $ do+ version "mv1" $ do+ route $ setExtension "mv1"+ compile getResourceString+ version "mv2" $ do+ route $ setExtension "mv2"+ compile getResourceString
+ tests/Hakyll/Core/Runtime/Tests.hs view
@@ -0,0 +1,50 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Core.Runtime.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import System.FilePath ((</>))+import Test.Framework (Test, testGroup)+import Test.HUnit (Assertion, (@?=))+++--------------------------------------------------------------------------------+import Hakyll+import qualified Hakyll.Core.Logger as Logger+import Hakyll.Core.Runtime+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Runtime.Tests" $ fromAssertions "run" [case01]+++--------------------------------------------------------------------------------+case01 :: Assertion+case01 = do+ _ <- run testConfiguration Logger.Error $ do+ match "*.md" $ do+ route $ setExtension "html"+ compile $ do+ getResourceBody+ >>= saveSnapshot "raw"+ >>= return . renderPandoc++ create ["bodies.txt"] $ do+ route idRoute+ compile $ do+ items <- loadAllSnapshots "*.md" "raw"+ makeItem $ concat $ map itemBody (items :: [Item String])++ example <- readFile $+ destinationDirectory testConfiguration </> "example.html"+ lines example @?= ["<p>This is an example.</p>"]++ bodies <- readFile $ destinationDirectory testConfiguration </> "bodies.txt"+ head (lines bodies) @?= "This is an example."++ cleanTestEnv
tests/Hakyll/Core/Store/Tests.hs view
@@ -7,12 +7,12 @@ -------------------------------------------------------------------------------- import Data.Typeable (typeOf)-import Test.Framework-import Test.Framework.Providers.HUnit-import Test.Framework.Providers.QuickCheck2+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.Framework.Providers.QuickCheck2 (testProperty) import qualified Test.HUnit as H-import Test.QuickCheck-import Test.QuickCheck.Monadic+import qualified Test.QuickCheck as Q+import qualified Test.QuickCheck.Monadic as Q --------------------------------------------------------------------------------@@ -21,8 +21,8 @@ ---------------------------------------------------------------------------------tests :: [Test]-tests =+tests :: Test+tests = testGroup "Hakyll.Core.Store.Tests" [ testProperty "simple get . set" simpleSetGet , testProperty "persistent get . set" persistentSetGet , testCase "WrongType get . set" wrongType@@ -30,37 +30,38 @@ ---------------------------------------------------------------------------------simpleSetGet :: Property-simpleSetGet = monadicIO $ do- key <- pick arbitrary- value <- pick arbitrary- store <- run $ makeStoreTest- run $ Store.set store key (value :: String)- value' <- run $ Store.get store key- assert $ Store.Found value == value'+simpleSetGet :: Q.Property+simpleSetGet = Q.monadicIO $ do+ key <- Q.pick Q.arbitrary+ value <- Q.pick Q.arbitrary+ store <- Q.run newTestStore+ Q.run $ Store.set store key (value :: String)+ value' <- Q.run $ Store.get store key+ Q.assert $ Store.Found value == value'+ Q.run cleanTestEnv ---------------------------------------------------------------------------------persistentSetGet :: Property-persistentSetGet = monadicIO $ do- key <- pick arbitrary- value <- pick arbitrary- store1 <- run $ makeStoreTest- run $ Store.set store1 key (value :: String)+persistentSetGet :: Q.Property+persistentSetGet = Q.monadicIO $ do+ key <- Q.pick Q.arbitrary+ value <- Q.pick Q.arbitrary+ store1 <- Q.run newTestStore+ Q.run $ Store.set store1 key (value :: String) -- Now Create another store from the same dir to test persistence- store2 <- run $ makeStoreTest- value' <- run $ Store.get store2 key- assert $ Store.Found value == value'+ store2 <- Q.run newTestStore+ value' <- Q.run $ Store.get store2 key+ Q.assert $ Store.Found value == value'+ Q.run cleanTestEnv -------------------------------------------------------------------------------- wrongType :: H.Assertion wrongType = do- store <- makeStoreTest+ store <- newTestStore -- Store a string and try to fetch an int Store.set store ["foo", "bar"] ("qux" :: String) value <- Store.get store ["foo", "bar"] :: IO (Store.Result Int)- print value H.assert $ case value of Store.WrongType e t -> e == typeOf (undefined :: Int) &&
tests/Hakyll/Core/UnixFilter/Tests.hs view
@@ -1,50 +1,39 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Core.UnixFilter.Tests- where+ ( tests+ ) where -import Control.Arrow ((>>>))-import qualified Data.Map as M -import Test.Framework (Test)-import Test.Framework.Providers.HUnit (testCase)-import qualified Test.HUnit as H-import qualified Data.Text.Lazy as TL-import qualified Data.Text.Lazy.Encoding as TL+--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import qualified Test.HUnit as H -import Hakyll.Core.Compiler-import Hakyll.Core.Resource.Provider.Dummy-import Hakyll.Core.UnixFilter-import TestSuite.Util -tests :: [Test]-tests =+--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Item+import Hakyll.Core.UnixFilter+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.UnixFilter.Tests" [ testCase "unixFilter rev" unixFilterRev ] ++-------------------------------------------------------------------------------- unixFilterRev :: H.Assertion unixFilterRev = do- provider <- dummyResourceProvider $ M.singleton "foo" $- TL.encodeUtf8 $ TL.pack text- output <- runCompilerJobTest compiler "foo" provider ["foo"]- H.assert $ rev text == lines output+ store <- newTestStore+ provider <- newTestProvider store+ output <- testCompilerDone store provider "russian.md" compiler+ expected <- testCompilerDone store provider "russian.md" getResourceString+ H.assert $ rev (itemBody expected) == lines (itemBody output)+ cleanTestEnv where- compiler = getResource >>> getResourceString >>> unixFilter "rev" []- rev = map reverse . lines--text :: String-text = unlines- [ "Статья 18"- , ""- , "Каждый человек имеет право на свободу мысли, совести и религии; это"- , "право включает свободу менять свою религию или убеждения и свободу"- , "исповедовать свою религию или убеждения как единолично, так и сообща с"- , "другими, публичным или частным порядком в учении, богослужении и"- , "выполнении религиозных и ритуальных обрядов."- , ""- , "Статья 19"- , ""- , "Каждый человек имеет право на свободу убеждений и на свободное выражение"- , "их; это право включает свободу беспрепятственно придерживаться своих"- , "убеждений и свободу искать, получать и распространять информацию и идеи"- , "любыми средствами и независимо от государственных границ."- ]+ compiler = getResourceString >>= withItemBody (unixFilter "rev" [])+ rev = map reverse . lines
− tests/Hakyll/Core/Util/Arrow/Tests.hs
@@ -1,14 +0,0 @@-module Hakyll.Core.Util.Arrow.Tests- ( tests- ) where--import Test.Framework (Test)-import Test.HUnit ((@=?))--import Hakyll.Core.Util.Arrow-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "sequenceA"- [ [8, 20, 1] @=? sequenceA [(+ 4), (* 5), signum] (4 :: Int)- ]
tests/Hakyll/Core/Util/String/Tests.hs view
@@ -1,15 +1,22 @@+-------------------------------------------------------------------------------- module Hakyll.Core.Util.String.Tests ( tests ) where -import Test.Framework (Test)-import Test.HUnit ((@=?)) -import Hakyll.Core.Util.String-import TestSuite.Util+--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.HUnit ((@=?)) -tests :: [Test]-tests = concat++--------------------------------------------------------------------------------+import Hakyll.Core.Util.String+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Util.String.Tests" $ concat [ fromAssertions "trim" [ "foo" @=? trim " foo\n\t " ]
+ tests/Hakyll/Web/Html/RelativizeUrls/Tests.hs view
@@ -0,0 +1,34 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Html.RelativizeUrls.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.HUnit ((@=?))++--------------------------------------------------------------------------------+import Hakyll.Web.Html.RelativizeUrls+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Web.Html.RelativizeUrls.Tests" $+ fromAssertions "relativizeUrls"+ [ "<a href=\"../foo\">bar</a>" @=?+ relativizeUrlsWith ".." "<a href=\"/foo\">bar</a>"+ , "<img src=\"../../images/lolcat.png\" />" @=?+ relativizeUrlsWith "../.." "<img src=\"/images/lolcat.png\" />"+ , "<a href=\"http://haskell.org\">Haskell</a>" @=?+ relativizeUrlsWith "../.."+ "<a href=\"http://haskell.org\">Haskell</a>"+ , "<a href=\"http://haskell.org\">Haskell</a>" @=?+ relativizeUrlsWith "../.."+ "<a href=\"http://haskell.org\">Haskell</a>"+ , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?+ relativizeUrlsWith "../.."+ "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"+ ]
+ tests/Hakyll/Web/Html/Tests.hs view
@@ -0,0 +1,71 @@+--------------------------------------------------------------------------------+module Hakyll.Web.Html.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Data.Char (toUpper)+import Test.Framework (Test, testGroup)+import Test.HUnit (assert, (@=?))+++--------------------------------------------------------------------------------+import Hakyll.Web.Html+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Web.Html.Tests" $ concat+ [ fromAssertions "demoteHeaders"+ [ "<h2>A h1 title</h2>" @=?+ demoteHeaders "<h1>A h1 title</h1>"+ ]++ , fromAssertions "withUrls"+ [ "<a href=\"FOO\">bar</a>" @=?+ withUrls (map toUpper) "<a href=\"foo\">bar</a>"+ , "<img src=\"OH BAR\" />" @=?+ withUrls (map toUpper) "<img src=\"oh bar\" />"++ -- Test escaping+ , "<script>\"sup\"</script>" @=?+ withUrls id "<script>\"sup\"</script>"+ , "<code><stdio></code>" @=?+ withUrls id "<code><stdio></code>"+ , "<style>body > p { line-height: 1.3 }</style>" @=?+ withUrls id "<style>body > p { line-height: 1.3 }</style>"+ ]++ , fromAssertions "toUrl"+ [ "/foo/bar.html" @=? toUrl "foo/bar.html"+ , "/" @=? toUrl "/"+ , "/funny-pics.html" @=? toUrl "/funny-pics.html"+ ]++ , fromAssertions "toSiteRoot"+ [ ".." @=? toSiteRoot "/foo/bar.html"+ , "." @=? toSiteRoot "index.html"+ , "." @=? toSiteRoot "/index.html"+ , "../.." @=? toSiteRoot "foo/bar/qux"+ ]++ , fromAssertions "isExternal"+ [ assert (isExternal "http://reddit.com")+ , assert (isExternal "https://mail.google.com")+ , assert (not (isExternal "../header.png"))+ , assert (not (isExternal "/foo/index.html"))+ ]++ , fromAssertions "stripTags"+ [ "foo" @=? stripTags "<p>foo</p>"+ , "foo bar" @=? stripTags "<p>foo</p> bar"+ , "foo" @=? stripTags "<p>foo</p"+ ]++ , fromAssertions "escapeHtml"+ [ "Me & Dean" @=? escapeHtml "Me & Dean"+ , "<img>" @=? escapeHtml "<img>"+ ]+ ]
− tests/Hakyll/Web/Page/Metadata/Tests.hs
@@ -1,77 +0,0 @@-module Hakyll.Web.Page.Metadata.Tests- ( tests- ) where--import Test.Framework-import Test.HUnit hiding (Test)--import qualified Data.Map as M-import Data.Monoid (mempty)-import Data.Char (toLower)--import Hakyll.Web.Page-import Hakyll.Web.Page.Metadata-import TestSuite.Util--tests :: [Test]-tests = concat $- [ fromAssertions "getField"- [ "bar" @=? getField "foo" (Page (M.singleton "foo" "bar") "body\n")- , "" @=? getField "foo" (Page M.empty "body")- ]-- , fromAssertions "getFieldMaybe"- [ Just "bar" @=? getFieldMaybe "foo" (Page (M.singleton "foo" "bar") "")- , Nothing @=? getFieldMaybe "foo" (Page M.empty "body")- ]-- , fromAssertions "setField"- [ (Page (M.singleton "bar" "foo") "") @=? setField "bar" "foo" mempty- , (Page (M.singleton "bar" "foo") "") @=?- setField "bar" "foo" (Page (M.singleton "bar" "qux") "")- ]-- , fromAssertions "trySetField"- [ (Page (M.singleton "bar" "foo") "") @=? trySetField "bar" "foo" mempty- , (Page (M.singleton "bar" "qux") "") @=?- trySetField "bar" "foo" (Page (M.singleton "bar" "qux") "")- ]-- , fromAssertions "setFieldA"- [ (Page (M.singleton "bar" "foo") "") @=?- setFieldA "bar" (map toLower) (mempty, "FOO")- ]-- , fromAssertions "renderDateField"- [ (@=?) "January 31, 2010" $ getField "date" $ renderDateField- "date" "%B %e, %Y" "Date unknown" $ Page- (M.singleton "path" "/posts/2010-01-31-a-post.mkdwn") ""- , (@=?) "Date unknown" $ getField "date" $ renderDateField- "date" "%B %e, %Y" "Date unknown" $ Page- (M.singleton "path" "/posts/a-post.mkdwn") ""- , (@=?) "February 20, 2000" $ getField "date" $ renderDateField- "date" "%B %e, %Y" "Date unknown" $ flip Page "" $ M.fromList- [ ("path", "/posts/2010-01-31-a-post.mkdwn")- , ("published", "February 20, 2000 1:00 PM")- ]- , (@=?) "October 22, 2012" $ getField "date" $ renderDateField- "date" "%B %e, %Y" "Date unknown" $ Page- (M.singleton "date" "2012-10-22 14:35:24") ""- ]-- , fromAssertions "copyBodyToField"- [ (Page (M.singleton "bar" "foo") "foo") @=?- copyBodyToField "bar" (Page M.empty "foo")- ]-- , fromAssertions "copyBodyFromField"- [ (Page (M.singleton "bar" "foo") "foo") @=?- copyBodyFromField "bar" (Page (M.singleton "bar" "foo") "qux")- ]-- , fromAssertions "comparePagesByDate"- [ GT @=? comparePagesByDate- (Page (M.singleton "path" "/posts/1990-08-26-foo.mkdwn") "")- (Page (M.singleton "path" "/posts/1990-06-18-qux.mkdwn") "")- ]- ]
− tests/Hakyll/Web/Page/Tests.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Page.Tests- ( tests- ) where--import Test.Framework-import Test.HUnit hiding (Test)--import qualified Data.Map as M--import Hakyll.Web.Page-import Hakyll.Web.Page.Read-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "readPage"- [ Page (M.singleton "foo" "bar") "body" @=? readPage- "--- \n\- \foo: bar \n\- \--- \n\- \body"-- , Page M.empty "line one\nlijn twee" @=? readPage- "line one\n\- \lijn twee"-- , Page (M.fromList [("field1", "unos"), ("veld02", "deux")]) "" @=? readPage- "---\n\- \veld02: deux\n\- \field1: unos\n\- \---\n"-- , Page (M.fromList [("author", "jasper"), ("title", "lol")]) "O hai\n"- @=? readPage- "---\n\- \author: jasper\n\- \title: lol\n\- \...\n\- \O hai\n"- ]
+ tests/Hakyll/Web/Template/Context/Tests.hs view
@@ -0,0 +1,54 @@+--------------------------------------------------------------------------------+{-# LANGUAGE OverloadedStrings #-}+module Hakyll.Web.Template.Context.Tests+ ( tests+ ) where+++--------------------------------------------------------------------------------+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, (@=?))+++--------------------------------------------------------------------------------+import Hakyll.Core.Compiler+import Hakyll.Core.Identifier+import Hakyll.Core.Provider+import Hakyll.Core.Store (Store)+import Hakyll.Web.Template.Context+import TestSuite.Util+++--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Template.Context.Tests"+ [ testCase "testDateField" testDateField+ ]+++--------------------------------------------------------------------------------+testDateField :: Assertion+testDateField = do+ store <- newTestStore+ provider <- newTestProvider store++ date1 <- testContextDone store provider "example.md" "date" $+ dateField "date" "%B %e, %Y"+ date1 @=? "October 22, 2012"++ date2 <- testContextDone store provider+ "posts/2010-08-26-birthday.md" "date" $+ dateField "date" "%B %e, %Y"+ date2 @=? "August 26, 2010"++ cleanTestEnv+++--------------------------------------------------------------------------------+testContextDone :: Store -> Provider -> Identifier -> String+ -> Context String -> IO String+testContextDone store provider identifier key context =+ testCompilerDone store provider identifier $ do+ item <- getResourceBody+ unContext context key item
tests/Hakyll/Web/Template/Tests.hs view
@@ -1,55 +1,69 @@+-------------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Hakyll.Web.Template.Tests ( tests ) where -import Test.Framework-import Test.HUnit hiding (Test) -import qualified Data.Map as M+--------------------------------------------------------------------------------+import Data.Monoid (mconcat)+import Test.Framework (Test, testGroup)+import Test.Framework.Providers.HUnit (testCase)+import Test.HUnit (Assertion, (@=?), (@?=)) -import Hakyll.Web.Page-import Hakyll.Web.Template-import Hakyll.Web.Template.Read-import TestSuite.Util -tests :: [Test]-tests = fromAssertions "applyTemplate"- -- Hakyll templates- [ applyTemplateAssertion readTemplate applyTemplate- ("bar" @=?) "$foo$" [("foo", "bar")]+--------------------------------------------------------------------------------+import Hakyll.Core.Item+import Hakyll.Core.Provider+import Hakyll.Web.Pandoc+import Hakyll.Web.Template+import Hakyll.Web.Template.Context+import Hakyll.Web.Template.Internal+import Hakyll.Web.Template.List+import TestSuite.Util - , applyTemplateAssertion readTemplate applyTemplate- ("$ barqux" @=?) "$$ $foo$$bar$" [("foo", "bar"), ("bar", "qux")] - , applyTemplateAssertion readTemplate applyTemplate- ("$foo$" @=?) "$foo$" []+--------------------------------------------------------------------------------+tests :: Test+tests = testGroup "Hakyll.Core.Template.Tests"+ [ testCase "case01" case01+ , testCase "applyJoinTemplateList" testApplyJoinTemplateList+ ] - -- Hamlet templates- , applyTemplateAssertion readHamletTemplate applyTemplate- (("<head><title>notice</title></head><body>A paragraph</body>" @=?) .- filter (/= '\n'))- "<head>\n\- \ <title>#{title}\n\- \<body>\n\- \ A paragraph\n"- [("title", "notice")] - -- Missing keys- , let missing "foo" = "bar"- missing "bar" = "qux"- missing x = reverse x- in applyTemplateAssertion readTemplate (applyTemplateWith missing)- ("bar foo ver" @=?) "$foo$ $bar$ $rev$" [("bar", "foo")]+--------------------------------------------------------------------------------+case01 :: Assertion+case01 = do+ store <- newTestStore+ provider <- newTestProvider store++ out <- resourceString provider "template.html.out"+ tpl <- testCompilerDone store provider "template.html" $+ templateCompiler+ item <- testCompilerDone store provider "example.md" $+ pandocCompiler >>= applyTemplate (itemBody tpl) testContext++ out @=? itemBody item+++--------------------------------------------------------------------------------+testContext :: Context String+testContext = mconcat+ [ functionField "echo" (\args _ -> return $ unwords args)+ , defaultContext ] --- | Utility function to create quick template tests----applyTemplateAssertion :: (String -> Template)- -> (Template -> Page String -> Page String)- -> (String -> Assertion)- -> String- -> [(String, String)]- -> Assertion-applyTemplateAssertion parser apply correct template page =- correct $ pageBody (apply (parser template) (fromMap $ M.fromList page))++--------------------------------------------------------------------------------+testApplyJoinTemplateList :: Assertion+testApplyJoinTemplateList = do+ store <- newTestStore+ provider <- newTestProvider store+ str <- testCompilerDone store provider "item3" $+ applyJoinTemplateList ", " tpl defaultContext [i1, i2]++ str @?= "<b>Hello</b>, <b>World</b>"+ where+ i1 = Item "item1" "Hello"+ i2 = Item "item2" "World"+ tpl = Template [Chunk "<b>", Key "body", Chunk "</b>"]
− tests/Hakyll/Web/Urls/Relativize/Tests.hs
@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Hakyll.Web.Urls.Relativize.Tests- ( tests- ) where--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Urls.Relativize-import TestSuite.Util--tests :: [Test]-tests = fromAssertions "relativizeUrls"- [ "<a href=\"../foo\">bar</a>" @=?- relativizeUrls ".." "<a href=\"/foo\">bar</a>"- , "<img src=\"../../images/lolcat.png\" />" @=?- relativizeUrls "../.." "<img src=\"/images/lolcat.png\" />"- , "<a href=\"http://haskell.org\">Haskell</a>" @=?- relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"- , "<a href=\"http://haskell.org\">Haskell</a>" @=?- relativizeUrls "../.." "<a href=\"http://haskell.org\">Haskell</a>"- , "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>" @=?- relativizeUrls "../.."- "<script src=\"//ajax.googleapis.com/jquery.min.js\"></script>"- ]
− tests/Hakyll/Web/Urls/Tests.hs
@@ -1,46 +0,0 @@-module Hakyll.Web.Urls.Tests- ( tests- ) where--import Data.Char (toUpper)--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Urls-import TestSuite.Util--tests :: [Test]-tests = concat- [ fromAssertions "withUrls"- [ "<a href=\"FOO\">bar</a>" @=?- withUrls (map toUpper) "<a href=\"foo\">bar</a>"- , "<img src=\"OH BAR\" />" @=?- withUrls (map toUpper) "<img src=\"oh bar\" />"-- -- Test escaping- , "<script>\"sup\"</script>" @=?- withUrls id "<script>\"sup\"</script>"- , "<code><stdio></code>" @=?- withUrls id "<code><stdio></code>"- , "<style>body > p { line-height: 1.3 }</style>" @=?- withUrls id "<style>body > p { line-height: 1.3 }</style>"- ]- , fromAssertions "toUrl"- [ "/foo/bar.html" @=? toUrl "foo/bar.html"- , "/" @=? toUrl "/"- , "/funny-pics.html" @=? toUrl "/funny-pics.html"- ]- , fromAssertions "toSiteRoot"- [ ".." @=? toSiteRoot "/foo/bar.html"- , "." @=? toSiteRoot "index.html"- , "." @=? toSiteRoot "/index.html"- , "../.." @=? toSiteRoot "foo/bar/qux"- ]- , fromAssertions "isExternal"- [ assert (isExternal "http://reddit.com")- , assert (isExternal "https://mail.google.com")- , assert (not (isExternal "../header.png"))- , assert (not (isExternal "/foo/index.html"))- ]- ]
− tests/Hakyll/Web/Util/Html/Tests.hs
@@ -1,22 +0,0 @@-module Hakyll.Web.Util.Html.Tests- ( tests- ) where--import Test.Framework-import Test.HUnit hiding (Test)--import Hakyll.Web.Util.Html-import TestSuite.Util--tests :: [Test]-tests = concat- [ fromAssertions "stripTags"- [ "foo" @=? stripTags "<p>foo</p>"- , "foo bar" @=? stripTags "<p>foo</p> bar"- , "foo" @=? stripTags "<p>foo</p"- ]- , fromAssertions "escapeHtml"- [ "Me & Dean" @=? escapeHtml "Me & Dean"- , "<img>" @=? escapeHtml "<img>"- ]- ]
tests/TestSuite.hs view
@@ -1,53 +1,43 @@-module Main where+--------------------------------------------------------------------------------+module Main+ ( main+ ) where -import Test.Framework (defaultMain, testGroup) -import qualified Hakyll.Core.Compiler.Tests-import qualified Hakyll.Core.DependencyAnalyzer.Tests+--------------------------------------------------------------------------------+import Test.Framework (defaultMain)+++--------------------------------------------------------------------------------+import qualified Hakyll.Core.Dependencies.Tests import qualified Hakyll.Core.Identifier.Tests+import qualified Hakyll.Core.Provider.Tests import qualified Hakyll.Core.Routes.Tests import qualified Hakyll.Core.Rules.Tests+import qualified Hakyll.Core.Runtime.Tests import qualified Hakyll.Core.Store.Tests import qualified Hakyll.Core.UnixFilter.Tests-import qualified Hakyll.Core.Util.Arrow.Tests import qualified Hakyll.Core.Util.String.Tests-import qualified Hakyll.Web.Page.Tests-import qualified Hakyll.Web.Page.Metadata.Tests+import qualified Hakyll.Web.Html.RelativizeUrls.Tests+import qualified Hakyll.Web.Html.Tests+import qualified Hakyll.Web.Template.Context.Tests import qualified Hakyll.Web.Template.Tests-import qualified Hakyll.Web.Urls.Tests-import qualified Hakyll.Web.Urls.Relativize.Tests-import qualified Hakyll.Web.Util.Html.Tests ++-------------------------------------------------------------------------------- main :: IO () main = defaultMain- [ testGroup "Hakyll.Core.Compiler.Tests"- Hakyll.Core.Compiler.Tests.tests- , testGroup "Hakyll.Core.DependencyAnalyzer.Tests"- Hakyll.Core.DependencyAnalyzer.Tests.tests- , testGroup "Hakyll.Core.Identifier.Tests"- Hakyll.Core.Identifier.Tests.tests- , testGroup "Hakyll.Core.Routes.Tests"- Hakyll.Core.Routes.Tests.tests- , testGroup "Hakyll.Core.Rules.Tests"- Hakyll.Core.Rules.Tests.tests- , testGroup "Hakyll.Core.Store.Tests"- Hakyll.Core.Store.Tests.tests- , testGroup "Hakyll.Core.UnixFilter.Tests"- Hakyll.Core.UnixFilter.Tests.tests- , testGroup "Hakyll.Core.Util.Arrow.Tests"- Hakyll.Core.Util.Arrow.Tests.tests- , testGroup "Hakyll.Core.Util.String.Tests"- Hakyll.Core.Util.String.Tests.tests- , testGroup "Hakyll.Web.Page.Tests"- Hakyll.Web.Page.Tests.tests- , testGroup "Hakyll.Web.Page.Metadata.Tests"- Hakyll.Web.Page.Metadata.Tests.tests- , testGroup "Hakyll.Web.Template.Tests"- Hakyll.Web.Template.Tests.tests- , testGroup "Hakyll.Web.Urls.Tests"- Hakyll.Web.Urls.Tests.tests- , testGroup "Hakyll.Web.Urls.Relativize.Tests"- Hakyll.Web.Urls.Relativize.Tests.tests- , testGroup "Hakyll.Web.Util.Html.Tests"- Hakyll.Web.Util.Html.Tests.tests+ [ Hakyll.Core.Dependencies.Tests.tests+ , Hakyll.Core.Identifier.Tests.tests+ , Hakyll.Core.Provider.Tests.tests+ , Hakyll.Core.Routes.Tests.tests+ , Hakyll.Core.Rules.Tests.tests+ , Hakyll.Core.Runtime.Tests.tests+ , Hakyll.Core.Store.Tests.tests+ , Hakyll.Core.UnixFilter.Tests.tests+ , Hakyll.Core.Util.String.Tests.tests+ , Hakyll.Web.Html.RelativizeUrls.Tests.tests+ , Hakyll.Web.Html.Tests.tests+ , Hakyll.Web.Template.Context.Tests.tests+ , Hakyll.Web.Template.Tests.tests ]
tests/TestSuite/Util.hs view
@@ -1,45 +1,103 @@+-------------------------------------------------------------------------------- -- | Test utilities--- module TestSuite.Util ( fromAssertions- , makeStoreTest- , runCompilerJobTest+ , newTestStore+ , newTestProvider+ , testCompiler+ , testCompilerDone+ , testConfiguration+ , cleanTestEnv ) where -import Data.Monoid (mempty) -import Test.Framework-import Test.Framework.Providers.HUnit-import Test.HUnit hiding (Test)+--------------------------------------------------------------------------------+import Data.Monoid (mempty)+import qualified Data.Set as S+import Test.Framework+import Test.Framework.Providers.HUnit+import Test.HUnit hiding (Test)+import Text.Printf (printf) -import Hakyll.Core.Compiler.Internal-import Hakyll.Core.Identifier-import Hakyll.Core.Logger-import Hakyll.Core.Resource.Provider-import Hakyll.Core.Store (Store)-import qualified Hakyll.Core.Store as Store +--------------------------------------------------------------------------------+import Hakyll.Core.Compiler.Internal+import Hakyll.Core.Configuration+import Hakyll.Core.Identifier+import qualified Hakyll.Core.Logger as Logger+import Hakyll.Core.Provider+import Hakyll.Core.Store (Store)+import qualified Hakyll.Core.Store as Store+import Hakyll.Core.Util.File+++-------------------------------------------------------------------------------- fromAssertions :: String -- ^ Name -> [Assertion] -- ^ Cases -> [Test] -- ^ Result tests-fromAssertions name = zipWith testCase names- where- names = map (\n -> name ++ " [" ++ show n ++ "]") [1 :: Int ..]+fromAssertions name =+ zipWith testCase [printf "[%2d] %s" n name | n <- [1 :: Int ..]] --- | Create a store for testing----makeStoreTest :: IO Store-makeStoreTest = Store.new True "_store" --- | Testing for 'runCompilerJob'----runCompilerJobTest :: Compiler () a- -> Identifier ()- -> ResourceProvider- -> [Identifier ()]- -> IO a-runCompilerJobTest compiler id' provider uni = do- store <- makeStoreTest- logger <- makeLogger $ const $ return ()- Right x <- runCompilerJob compiler id' provider uni mempty store True logger- return x+--------------------------------------------------------------------------------+newTestStore :: IO Store+newTestStore = Store.new True $ storeDirectory testConfiguration+++--------------------------------------------------------------------------------+newTestProvider :: Store -> IO Provider+newTestProvider store = newProvider store (const False) $+ providerDirectory testConfiguration+++--------------------------------------------------------------------------------+testCompiler :: Store -> Provider -> Identifier -> Compiler a+ -> IO (CompilerResult a)+testCompiler store provider underlying compiler = do+ logger <- Logger.new Logger.Error+ let read' = CompilerRead+ { compilerConfig = testConfiguration+ , compilerUnderlying = underlying+ , compilerProvider = provider+ , compilerUniverse = S.empty+ , compilerRoutes = mempty+ , compilerStore = store+ , compilerLogger = logger+ }++ result <- runCompiler compiler read'+ Logger.flush logger+ return result+++--------------------------------------------------------------------------------+testCompilerDone :: Store -> Provider -> Identifier -> Compiler a -> IO a+testCompilerDone store provider underlying compiler = do+ result <- testCompiler store provider underlying compiler+ case result of+ CompilerDone x _ -> return x+ CompilerError e -> error $+ "TestSuite.Util.testCompilerDone: compiler " ++ show underlying +++ " threw: " ++ e+ CompilerRequire i _ -> error $+ "TestSuite.Util.testCompilerDone: compiler " ++ show underlying +++ " requires: " ++ show i++++--------------------------------------------------------------------------------+testConfiguration :: Configuration+testConfiguration = defaultConfiguration+ { destinationDirectory = "_testsite"+ , storeDirectory = "_teststore"+ , tmpDirectory = "_testtmp"+ , providerDirectory = "tests/data"+ }+++--------------------------------------------------------------------------------+cleanTestEnv :: IO ()+cleanTestEnv = do+ removeDirectory $ destinationDirectory testConfiguration+ removeDirectory $ storeDirectory testConfiguration+ removeDirectory $ tmpDirectory testConfiguration
+ tests/data/example.md view
@@ -0,0 +1,5 @@+---+title: An example+---++This is an example.
+ tests/data/example.md.metadata view
@@ -0,0 +1,2 @@+external: External data+date: 2012-10-22 14:35:24
+ tests/data/template.html view
@@ -0,0 +1,5 @@+<div>+ I'm so rich I have $$3.+ $echo test!$+ $body$+</div>
+ tests/data/template.html.out view
@@ -0,0 +1,5 @@+<div>+ I'm so rich I have $3.+ test!+ <p>This is an example.</p>+</div>