From 758e0beaaa2f9f97bb22fa4067d75efda4dbd31b Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Tue, 24 May 2011 11:58:13 +0200 Subject: Type-safe identifiers --- src/Hakyll/Core/Compiler.hs | 26 ++++++++++++++------------ src/Hakyll/Core/Compiler/Internal.hs | 24 ++++++++++++------------ src/Hakyll/Core/Identifier.hs | 29 +++++++++++++++++++++-------- src/Hakyll/Core/Identifier/Pattern.hs | 21 +++++++++++---------- src/Hakyll/Core/Resource.hs | 4 ++-- src/Hakyll/Core/Routes.hs | 11 ++++++----- src/Hakyll/Core/Rules.hs | 20 ++++++++++---------- src/Hakyll/Core/Rules/Internal.hs | 4 ++-- src/Hakyll/Core/Run.hs | 10 +++++----- src/Hakyll/Core/Store.hs | 6 +++--- src/Hakyll/Core/Writable.hs | 4 ++-- src/Hakyll/Web/Pandoc.hs | 18 +++++++++--------- src/Hakyll/Web/Tags.hs | 12 ++++++------ src/Hakyll/Web/Template.hs | 2 +- 14 files changed, 104 insertions(+), 87 deletions(-) (limited to 'src') diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 6237d5a..02e59ac 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -142,9 +142,9 @@ import Hakyll.Core.Logger -- version of 'runCompilerJob' also stores the result -- runCompiler :: Compiler () CompileRule -- ^ Compiler to run - -> Identifier -- ^ Target identifier + -> Identifier () -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> [Identifier] -- ^ Universe + -> [Identifier ()] -- ^ Universe -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? @@ -161,7 +161,8 @@ runCompiler compiler id' provider universe routes store modified logger = do -- before we return control. This makes sure the compiled item can later -- be accessed by e.g. require. Right (CompileRule (CompiledItem x)) -> - storeSet store "Hakyll.Core.Compiler.runCompiler" id' x + storeSet store "Hakyll.Core.Compiler.runCompiler" + (castIdentifier id') x -- Otherwise, we do nothing here _ -> return () @@ -170,8 +171,9 @@ runCompiler compiler id' provider universe routes store modified logger = do -- | Get the identifier of the item that is currently being compiled -- -getIdentifier :: Compiler a Identifier -getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask +getIdentifier :: Compiler a (Identifier b) +getIdentifier = fromJob $ const $ CompilerM $ + castIdentifier . compilerIdentifier <$> ask -- | Get the route we are using for this item -- @@ -180,7 +182,7 @@ getRoute = getIdentifier >>> getRouteFor -- | Get the route for a specified item -- -getRouteFor :: Compiler Identifier (Maybe FilePath) +getRouteFor :: Compiler (Identifier a) (Maybe FilePath) getRouteFor = fromJob $ \identifier -> CompilerM $ do routes <- compilerRoutes <$> ask return $ runRoutes routes identifier @@ -212,7 +214,7 @@ getResourceWith reader = fromJob $ \resource -> CompilerM $ do -- | Auxiliary: get a dependency -- getDependency :: (Binary a, Writable a, Typeable a) - => Identifier -> CompilerM a + => Identifier a -> CompilerM a getDependency id' = CompilerM $ do store <- compilerStore <$> ask result <- liftIO $ storeGet store "Hakyll.Core.Compiler.runCompiler" id' @@ -233,7 +235,7 @@ getDependency id' = CompilerM $ do -- | Variant of 'require' which drops the current value -- require_ :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> Compiler b a require_ identifier = fromDependency identifier >>> fromJob (const $ getDependency identifier) @@ -242,7 +244,7 @@ require_ identifier = -- dependencies -- require :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> (b -> a -> c) -> Compiler b c require identifier = requireA identifier . arr . uncurry @@ -250,7 +252,7 @@ require identifier = requireA identifier . arr . uncurry -- | Arrow-based variant of 'require' -- requireA :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier a -> Compiler (b, a) c -> Compiler b c requireA identifier = (id &&& require_ identifier >>>) @@ -262,7 +264,7 @@ requireAll_ :: (Binary a, Typeable a, Writable a) -> Compiler b [a] requireAll_ pattern = fromDependencies (const getDeps) >>> fromJob requireAll_' where - getDeps = filterMatches pattern + getDeps = map castIdentifier . filterMatches pattern . map castIdentifier requireAll_' = const $ CompilerM $ do deps <- getDeps . compilerUniverse <$> ask mapM (unCompilerM . getDependency) deps @@ -290,7 +292,7 @@ cached :: (Binary a, Typeable a, Writable a) -> Compiler Resource a cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do logger <- compilerLogger <$> ask - identifier <- compilerIdentifier <$> ask + identifier <- castIdentifier . compilerIdentifier <$> ask store <- compilerStore <$> ask modified <- compilerResourceModified <$> ask report logger $ "Checking cache: " ++ if modified then "modified" else "OK" diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs index 594c23e..8ed822d 100644 --- a/src/Hakyll/Core/Compiler/Internal.hs +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -33,26 +33,26 @@ import Hakyll.Core.Logger -- | A set of dependencies -- -type Dependencies = Set Identifier +type Dependencies = Set (Identifier ()) -- | Environment in which the dependency analyzer runs -- data DependencyEnvironment = DependencyEnvironment { -- | Target identifier - dependencyIdentifier :: Identifier + dependencyIdentifier :: Identifier () , -- | List of available identifiers we can depend upon - dependencyUniverse :: [Identifier] + dependencyUniverse :: [Identifier ()] } -- | Environment in which a compiler runs -- data CompilerEnvironment = CompilerEnvironment { -- | Target identifier - compilerIdentifier :: Identifier + compilerIdentifier :: Identifier () , -- | Resource provider compilerResourceProvider :: ResourceProvider , -- | List of all known identifiers - compilerUniverse :: [Identifier] + compilerUniverse :: [Identifier ()] , -- | Site routes compilerRoutes :: Routes , -- | Compiler store @@ -107,9 +107,9 @@ instance ArrowChoice Compiler where -- | Run a compiler, yielding the resulting target -- runCompilerJob :: Compiler () a -- ^ Compiler to run - -> Identifier -- ^ Target identifier + -> Identifier () -- ^ Target identifier -> ResourceProvider -- ^ Resource provider - -> [Identifier] -- ^ Universe + -> [Identifier ()] -- ^ Universe -> Routes -- ^ Route -> Store -- ^ Store -> Bool -- ^ Was the resource modified? @@ -129,8 +129,8 @@ runCompilerJob compiler id' provider universe route store modified logger = } runCompilerDependencies :: Compiler () a - -> Identifier - -> [Identifier] + -> Identifier () + -> [Identifier ()] -> Dependencies runCompilerDependencies compiler identifier universe = runReader (compilerDependencies compiler) env @@ -144,7 +144,7 @@ fromJob :: (a -> CompilerM b) -> Compiler a b fromJob = Compiler (return S.empty) -fromDependencies :: (Identifier -> [Identifier] -> [Identifier]) +fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()]) -> Compiler b b fromDependencies collectDeps = flip Compiler return $ do DependencyEnvironment identifier universe <- ask @@ -152,5 +152,5 @@ fromDependencies collectDeps = flip Compiler return $ do -- | Wait until another compiler has finished before running this compiler -- -fromDependency :: Identifier -> Compiler a a -fromDependency = fromDependencies . const . const . return +fromDependency :: Identifier a -> Compiler b b +fromDependency = fromDependencies . const . const . return . castIdentifier diff --git a/src/Hakyll/Core/Identifier.hs b/src/Hakyll/Core/Identifier.hs index c2455fc..b413b32 100644 --- a/src/Hakyll/Core/Identifier.hs +++ b/src/Hakyll/Core/Identifier.hs @@ -23,6 +23,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Hakyll.Core.Identifier ( Identifier (..) + , castIdentifier , parseIdentifier , toFilePath , setGroup @@ -40,30 +41,42 @@ import Data.Typeable (Typeable) -- | An identifier used to uniquely identify a value -- -data Identifier = Identifier +-- The @a@ is used to denote the type that the identifier points to. It is a +-- phantom type parameter, meaning you can safely change this if you know what +-- you are doing. +-- +-- If the @a@ type is not known, Hakyll traditionally uses @Identifier ()@. +-- +data Identifier a = Identifier { identifierGroup :: Maybe String , identifierPath :: String } deriving (Eq, Ord, Typeable) -instance Monoid Identifier where +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 where +instance Binary (Identifier a) where put (Identifier g p) = put g >> put p get = Identifier <$> get <*> get -instance Show Identifier where +instance Show (Identifier a) where show i@(Identifier Nothing _) = toFilePath i show i@(Identifier (Just g) _) = toFilePath i ++ " (" ++ g ++ ")" -instance IsString Identifier where +instance IsString (Identifier a) where fromString = parseIdentifier +-- | Discard the phantom type parameter of an identifier +-- +castIdentifier :: Identifier a -> Identifier b +castIdentifier (Identifier g p) = Identifier g p +{-# INLINE castIdentifier #-} + -- | Parse an identifier from a string -- -parseIdentifier :: String -> Identifier +parseIdentifier :: String -> Identifier a parseIdentifier = Identifier Nothing . intercalate "/" . filter (not . null) . split' where @@ -73,10 +86,10 @@ parseIdentifier = Identifier Nothing -- | Convert an identifier to a relative 'FilePath' -- -toFilePath :: Identifier -> FilePath +toFilePath :: Identifier a -> FilePath toFilePath = identifierPath -- | Set the identifier group for some identifier -- -setGroup :: Maybe String -> Identifier -> Identifier +setGroup :: Maybe String -> Identifier a -> Identifier a setGroup g (Identifier _ p) = Identifier g p diff --git a/src/Hakyll/Core/Identifier/Pattern.hs b/src/Hakyll/Core/Identifier/Pattern.hs index a7a534e..e1025ed 100644 --- a/src/Hakyll/Core/Identifier/Pattern.hs +++ b/src/Hakyll/Core/Identifier/Pattern.hs @@ -66,8 +66,8 @@ data GlobComponent = Capture -- | Type that allows matching on identifiers -- data Pattern a = Glob [GlobComponent] - | Predicate (Identifier -> Bool) - | List [Identifier] + | Predicate (Identifier a -> Bool) + | List [Identifier a] instance IsString (Pattern a) where fromString = parseGlob @@ -80,8 +80,9 @@ instance Monoid (Pattern a) where -- castPattern :: Pattern a -> Pattern b castPattern (Glob g) = Glob g -castPattern (Predicate p) = Predicate p -castPattern (List l) = List l +castPattern (Predicate p) = Predicate $ p . castIdentifier +castPattern (List l) = List $ map castIdentifier l +{-# INLINE castPattern #-} -- | Parse a pattern from a string -- @@ -102,7 +103,7 @@ parseGlob = Glob . parse' -- -- > predicate (\i -> matches "foo/*" i && not (matches "foo/bar" i)) -- -predicate :: (Identifier -> Bool) -> Pattern a +predicate :: (Identifier a -> Bool) -> Pattern a predicate = Predicate -- | Create a 'Pattern' from a regex @@ -122,14 +123,14 @@ inGroup group = predicate $ (== group) . identifierGroup -- | Check if an identifier matches a pattern -- -matches :: Pattern a -> Identifier -> Bool +matches :: Pattern a -> Identifier a -> Bool matches (Glob p) = isJust . capture (Glob p) matches (Predicate p) = (p $) matches (List l) = (`elem` l) -- | Given a list of identifiers, retain only those who match the given pattern -- -filterMatches :: Pattern a -> [Identifier] -> [Identifier] +filterMatches :: Pattern a -> [Identifier a] -> [Identifier a] filterMatches = filter . matches -- | Split a list at every possible point, generate a list of (init, tail) @@ -140,7 +141,7 @@ splits = inits &&& tails >>> uncurry zip >>> reverse -- | Match a glob against a pattern, generating a list of captures -- -capture :: Pattern a -> Identifier -> Maybe [String] +capture :: Pattern a -> Identifier a -> Maybe [String] capture (Glob p) (Identifier _ i) = capture' p i capture _ _ = Nothing @@ -172,13 +173,13 @@ capture' (CaptureMany : ms) str = -- -- > "tags/foo" -- -fromCapture :: Pattern a -> String -> Identifier +fromCapture :: Pattern a -> String -> Identifier a 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 +fromCaptures :: Pattern a -> [String] -> Identifier a fromCaptures (Glob p) = Identifier Nothing . fromCaptures' p fromCaptures _ = error $ "Hakyll.Core.Identifier.Pattern.fromCaptures: fromCaptures only works " ++ diff --git a/src/Hakyll/Core/Resource.hs b/src/Hakyll/Core/Resource.hs index 8154752..ce5da81 100644 --- a/src/Hakyll/Core/Resource.hs +++ b/src/Hakyll/Core/Resource.hs @@ -15,10 +15,10 @@ newtype Resource = Resource {unResource :: String} -- | Create a resource from an identifier -- -fromIdentifier :: Identifier -> Resource +fromIdentifier :: Identifier a -> Resource fromIdentifier = Resource . toFilePath -- | Map the resource to an identifier. Note that the group will not be set! -- -toIdentifier :: Resource -> Identifier +toIdentifier :: Resource -> Identifier a toIdentifier = parseIdentifier . unResource diff --git a/src/Hakyll/Core/Routes.hs b/src/Hakyll/Core/Routes.hs index 0b500b3..f351447 100644 --- a/src/Hakyll/Core/Routes.hs +++ b/src/Hakyll/Core/Routes.hs @@ -25,6 +25,7 @@ -- -- * If an item matches multiple routes, the first rule will be chosen. -- +{-# LANGUAGE Rank2Types #-} module Hakyll.Core.Routes ( Routes , runRoutes @@ -46,7 +47,7 @@ import Hakyll.Core.Util.String -- | Type used for a route -- -newtype Routes = Routes {unRoutes :: Identifier -> Maybe FilePath} +newtype Routes = Routes {unRoutes :: forall a. Identifier a -> Maybe FilePath} instance Monoid Routes where mempty = Routes $ const Nothing @@ -54,7 +55,7 @@ instance Monoid Routes where -- | Apply a route to an identifier -- -runRoutes :: Routes -> Identifier -> Maybe FilePath +runRoutes :: Routes -> Identifier a -> Maybe FilePath runRoutes = unRoutes -- | A route that uses the identifier as filepath. For example, the target with @@ -90,13 +91,13 @@ setExtension extension = Routes $ fmap (`replaceExtension` extension) -- matchRoute :: Pattern a -> Routes -> Routes matchRoute pattern (Routes route) = Routes $ \id' -> - if matches pattern id' then route id' else Nothing + if matches pattern (castIdentifier id') then route id' else Nothing -- | Create a custom route. This should almost always be used with -- 'matchRoute' -- -customRoute :: (Identifier -> FilePath) -> Routes -customRoute f = Routes $ Just . f +customRoute :: (Identifier a -> FilePath) -> Routes +customRoute f = Routes $ Just . f . castIdentifier -- | Create a gsub route -- diff --git a/src/Hakyll/Core/Rules.hs b/src/Hakyll/Core/Rules.hs index a9e1375..ee115a9 100644 --- a/src/Hakyll/Core/Rules.hs +++ b/src/Hakyll/Core/Rules.hs @@ -31,7 +31,7 @@ module Hakyll.Core.Rules import Control.Applicative ((<$>)) import Control.Monad.Writer (tell) import Control.Monad.Reader (ask, local) -import Control.Arrow (second, (>>>), arr, (>>^), (***)) +import Control.Arrow ((>>>), arr, (>>^), (***)) import Control.Monad.State (get, put) import Data.Monoid (mempty, mappend) import qualified Data.Set as S @@ -58,13 +58,13 @@ tellRoute route' = RulesM $ tell $ RuleSet route' mempty mempty -- | Add a number of compilers -- tellCompilers :: (Binary a, Typeable a, Writable a) - => [(Identifier, Compiler () a)] + => [(Identifier a, Compiler () a)] -> Rules tellCompilers compilers = RulesM $ do -- We box the compilers so they have a more simple type, and we apply the -- current group to the corresponding identifiers - group' <- rulesGroup <$> ask - let compilers' = map (setGroup group' *** boxCompiler) compilers + g <- rulesGroup <$> ask + let compilers' = map (setGroup g . castIdentifier *** boxCompiler) compilers tell $ RuleSet mempty compilers' mempty where boxCompiler = (>>> arr compiledItem >>> arr CompileRule) @@ -143,7 +143,7 @@ compile compiler = do -- actual content itself. -- create :: (Binary a, Typeable a, Writable a) - => Identifier -> Compiler () a -> Rules + => Identifier a -> Compiler () a -> Rules create identifier compiler = tellCompilers [(identifier, compiler)] -- | Add a route. @@ -160,7 +160,7 @@ route route' = RulesM $ do -- | Get a list of resources matching the current pattern -- -resources :: RulesM [Identifier] +resources :: RulesM [Identifier a] resources = RulesM $ do pattern <- rulesPattern <$> ask provider <- rulesResourceProvider <$> ask @@ -197,7 +197,7 @@ resources = RulesM $ do -- which items must be rendered. -- metaCompile :: (Binary a, Typeable a, Writable a) - => Compiler () [(Identifier, Compiler () a)] + => Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -217,9 +217,9 @@ metaCompile compiler = RulesM $ do -- the metacompiler. -- metaCompileWith :: (Binary a, Typeable a, Writable a) - => Identifier + => Identifier () -- ^ Identifier for this compiler - -> Compiler () [(Identifier, Compiler () a)] + -> Compiler () [(Identifier a, Compiler () a)] -- ^ Compiler generating the other compilers -> Rules -- ^ Resulting rules @@ -229,7 +229,7 @@ metaCompileWith identifier compiler = RulesM $ do let -- Set the correct group on the identifier id' = setGroup group' identifier -- Function to box an item into a rule - makeRule = MetaCompileRule . map (second box) + makeRule = MetaCompileRule . map (castIdentifier *** box) -- Entire boxing function box = (>>> fromDependency id' >>^ CompileRule . compiledItem) -- Resulting compiler list diff --git a/src/Hakyll/Core/Rules/Internal.hs b/src/Hakyll/Core/Rules/Internal.hs index fe16062..5a1ab8e 100644 --- a/src/Hakyll/Core/Rules/Internal.hs +++ b/src/Hakyll/Core/Rules/Internal.hs @@ -35,7 +35,7 @@ import Hakyll.Core.CompiledItem -- added to the runtime if possible, since other items might depend upon them. -- data CompileRule = CompileRule CompiledItem - | MetaCompileRule [(Identifier, Compiler () CompileRule)] + | MetaCompileRule [(Identifier (), Compiler () CompileRule)] -- | A collection of rules for the compilation process -- @@ -43,7 +43,7 @@ data RuleSet = RuleSet { -- | Routes used in the compilation structure rulesRoutes :: Routes , -- | Compilation rules - rulesCompilers :: [(Identifier, Compiler () CompileRule)] + rulesCompilers :: [(Identifier (), Compiler () CompileRule)] , -- | A list of the used resources rulesResources :: Set Resource } diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 643aa4e..8bde15d 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -89,8 +89,8 @@ data RuntimeEnvironment = RuntimeEnvironment } data RuntimeState = RuntimeState - { hakyllAnalyzer :: DependencyAnalyzer Identifier - , hakyllCompilers :: Map Identifier (Compiler () CompileRule) + { hakyllAnalyzer :: DependencyAnalyzer (Identifier ()) + , hakyllCompilers :: Map (Identifier ()) (Compiler () CompileRule) } newtype Runtime a = Runtime @@ -99,7 +99,7 @@ newtype Runtime a = Runtime -- | Add a number of compilers and continue using these compilers -- -addNewCompilers :: [(Identifier, Compiler () CompileRule)] +addNewCompilers :: [(Identifier (), Compiler () CompileRule)] -- ^ Compilers to add -> Runtime () addNewCompilers newCompilers = Runtime $ do @@ -157,14 +157,14 @@ stepAnalyzer = Runtime $ do -- | Dump cyclic error and quit -- -dumpCycle :: [Identifier] -> Runtime () +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 :: Identifier () -> Runtime () build id' = Runtime $ do logger <- hakyllLogger <$> ask routes <- hakyllRoutes <$> ask diff --git a/src/Hakyll/Core/Store.hs b/src/Hakyll/Core/Store.hs index 20e85d7..3000910 100644 --- a/src/Hakyll/Core/Store.hs +++ b/src/Hakyll/Core/Store.hs @@ -60,7 +60,7 @@ addToMap store path value = -- | Create a path -- -makePath :: Store -> String -> Identifier -> FilePath +makePath :: Store -> String -> Identifier a -> FilePath makePath store name identifier = storeDirectory store name group toFilePath identifier "hakyllstore" where @@ -69,7 +69,7 @@ makePath store name identifier = storeDirectory store name -- | Store an item -- storeSet :: (Binary a, Typeable a) - => Store -> String -> Identifier -> a -> IO () + => Store -> String -> Identifier a -> a -> IO () storeSet store name identifier value = do makeDirectories path encodeFile path value @@ -80,7 +80,7 @@ storeSet store name identifier value = do -- | Load an item -- storeGet :: forall a. (Binary a, Typeable a) - => Store -> String -> Identifier -> IO (StoreGet a) + => Store -> String -> Identifier a -> IO (StoreGet a) storeGet store name identifier = do -- First check the in-memory map map' <- readMVar $ storeMap store diff --git a/src/Hakyll/Core/Writable.hs b/src/Hakyll/Core/Writable.hs index b7a4116..d001f00 100644 --- a/src/Hakyll/Core/Writable.hs +++ b/src/Hakyll/Core/Writable.hs @@ -38,5 +38,5 @@ instance Writable [Word8] where instance Writable Html where write p html = write p $ renderHtml html -instance Writable Identifier where - write p i = write p $ show i +instance Writable (Identifier a) where + write p = write p . show diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs index d107702..a1bd09c 100644 --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -33,19 +33,19 @@ import Hakyll.Web.Page.Internal -- | Read a string using pandoc, with the default options -- -readPandoc :: FileType -- ^ File type, determines how parsing happens - -> Maybe Identifier -- ^ Optional, for better error messages - -> String -- ^ String to read - -> Pandoc -- ^ Resulting document +readPandoc :: FileType -- ^ Determines how parsing happens + -> Maybe (Identifier a) -- ^ Optional, for better error messages + -> String -- ^ String to read + -> Pandoc -- ^ Resulting document readPandoc = readPandocWith defaultHakyllParserState -- | Read a string using pandoc, with the supplied options -- -readPandocWith :: ParserState -- ^ Parser options - -> FileType -- ^ File type, determines parsing method - -> Maybe Identifier -- ^ Optional, for better error messages - -> String -- ^ String to read - -> Pandoc -- ^ Resulting document +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 diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs index 32076a0..d05256e 100644 --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -111,7 +111,7 @@ readCategory = readTagsWith getCategory -- | Render tags in HTML -- -renderTags :: (String -> Identifier) +renderTags :: (String -> Identifier a) -- ^ Produce a link -> (String -> String -> Int -> Int -> Int -> String) -- ^ Produce a tag item: tag, url, count, min count, max count @@ -141,7 +141,7 @@ renderTags makeUrl makeItem concatItems = proc (Tags tags) -> do -- | Render a tag cloud in HTML -- -renderTagCloud :: (String -> Identifier) -- ^ Produce a link for a tag +renderTagCloud :: (String -> Identifier a) -- ^ Produce a link for a tag -> Double -- ^ Smallest font size, in percent -> Double -- ^ Biggest font size, in percent -> Compiler (Tags a) String -- ^ Tag cloud renderer @@ -162,7 +162,7 @@ renderTagCloud makeUrl minSize maxSize = -- | Render a simple tag list in HTML, with the tag count next to the item -- -renderTagList :: (String -> Identifier) -> Compiler (Tags a) (String) +renderTagList :: (String -> Identifier a) -> Compiler (Tags a) (String) renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ") where makeLink tag url count _ _ = renderHtml $ @@ -172,7 +172,7 @@ renderTagList makeUrl = renderTags makeUrl makeLink (intercalate ", ") -- renderTagsFieldWith :: (Page a -> [String]) -- ^ Function to get the tags -> String -- ^ Destination key - -> (String -> Identifier) -- ^ Create a link for a tag + -> (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' @@ -192,13 +192,13 @@ renderTagsFieldWith tags destination makeUrl = -- | Render tags with links -- renderTagsField :: String -- ^ Destination key - -> (String -> Identifier) -- ^ Create a link for a tag + -> (String -> Identifier a) -- ^ Create a link for a tag -> Compiler (Page a) (Page a) -- ^ Resulting compiler renderTagsField = renderTagsFieldWith getTags -- | Render the category in a link -- renderCategoryField :: String -- ^ Destination key - -> (String -> Identifier) -- ^ Create a category link + -> (String -> Identifier a) -- ^ Create a category link -> Compiler (Page a) (Page a) -- ^ Resulting compiler renderCategoryField = renderTagsFieldWith getCategory diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 33e7a9b..222ab23 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -104,6 +104,6 @@ templateCompilerWith settings = -- Hakyll template else readTemplate string -applyTemplateCompiler :: Identifier -- ^ Template +applyTemplateCompiler :: Identifier Template -- ^ Template -> Compiler (Page String) (Page String) -- ^ Compiler applyTemplateCompiler identifier = require identifier (flip applyTemplate) -- cgit v1.2.3