Use Typeable instead of ADT
This commit is contained in:
parent
6ffb83d46f
commit
27ff2eef89
9 changed files with 132 additions and 69 deletions
39
src/Hakyll/Core/CompiledItem.hs
Normal file
39
src/Hakyll/Core/CompiledItem.hs
Normal file
|
@ -0,0 +1,39 @@
|
||||||
|
-- | A module containing a box datatype representing a compiled item. This
|
||||||
|
-- item can be of any type, given that a few restrictions hold (e.g. we want
|
||||||
|
-- a 'Typeable' instance to perform type-safe casts).
|
||||||
|
--
|
||||||
|
{-# LANGUAGE ExistentialQuantification #-}
|
||||||
|
module Hakyll.Core.CompiledItem
|
||||||
|
( CompiledItem
|
||||||
|
, compiledItem
|
||||||
|
, unCompiledItem
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Data.Binary (Binary)
|
||||||
|
import Data.Typeable (Typeable, cast)
|
||||||
|
|
||||||
|
import Hakyll.Core.Writable
|
||||||
|
|
||||||
|
-- | Box type for a compiled item
|
||||||
|
--
|
||||||
|
data CompiledItem = forall a. (Binary a, Typeable a, Writable a)
|
||||||
|
=> CompiledItem a
|
||||||
|
|
||||||
|
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) = case cast x of
|
||||||
|
Just x' -> x'
|
||||||
|
Nothing -> error "unCompiledItem: Unsupported type"
|
|
@ -16,10 +16,14 @@ import Control.Monad.State (State, modify, runState)
|
||||||
import Control.Monad.Reader (ReaderT, ask, runReaderT)
|
import Control.Monad.Reader (ReaderT, ask, runReaderT)
|
||||||
import Data.Set (Set)
|
import Data.Set (Set)
|
||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
|
import Data.Binary (Binary)
|
||||||
|
|
||||||
import Hakyll.Core.Identifier
|
import Hakyll.Core.Identifier
|
||||||
import Hakyll.Core.Target
|
import Hakyll.Core.Target
|
||||||
import Hakyll.Core.Target.Internal
|
import Hakyll.Core.Target.Internal
|
||||||
|
import Hakyll.Core.CompiledItem
|
||||||
|
import Hakyll.Core.Writable
|
||||||
|
|
||||||
-- | A set of dependencies
|
-- | A set of dependencies
|
||||||
--
|
--
|
||||||
|
@ -27,7 +31,7 @@ type Dependencies = Set Identifier
|
||||||
|
|
||||||
-- | Add one dependency
|
-- | Add one dependency
|
||||||
--
|
--
|
||||||
addDependency :: Identifier -> CompilerM a ()
|
addDependency :: Identifier -> CompilerM ()
|
||||||
addDependency dependency = CompilerM $ modify $ addDependency'
|
addDependency dependency = CompilerM $ modify $ addDependency'
|
||||||
where
|
where
|
||||||
addDependency' x = x
|
addDependency' x = x
|
||||||
|
@ -36,8 +40,8 @@ addDependency dependency = CompilerM $ modify $ addDependency'
|
||||||
|
|
||||||
-- | Environment in which a compiler runs
|
-- | Environment in which a compiler runs
|
||||||
--
|
--
|
||||||
data CompilerEnvironment a = CompilerEnvironment
|
data CompilerEnvironment = CompilerEnvironment
|
||||||
{ compilerIdentifier :: Identifier -- ^ Target identifier
|
{ compilerIdentifier :: Identifier -- ^ Target identifier
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | State carried along by a compiler
|
-- | State carried along by a compiler
|
||||||
|
@ -48,18 +52,18 @@ data CompilerState = CompilerState
|
||||||
|
|
||||||
-- | The compiler monad
|
-- | The compiler monad
|
||||||
--
|
--
|
||||||
newtype CompilerM a b = CompilerM
|
newtype CompilerM a = CompilerM
|
||||||
{ unCompilerM :: ReaderT (CompilerEnvironment a) (State CompilerState) b
|
{ unCompilerM :: ReaderT CompilerEnvironment (State CompilerState) a
|
||||||
} deriving (Monad, Functor, Applicative)
|
} deriving (Monad, Functor, Applicative)
|
||||||
|
|
||||||
-- | Simplified type for a compiler generating a target (which covers most
|
-- | Simplified type for a compiler generating a target (which covers most
|
||||||
-- cases)
|
-- cases)
|
||||||
--
|
--
|
||||||
type Compiler a = CompilerM a (TargetM a a)
|
type Compiler a = CompilerM (TargetM a)
|
||||||
|
|
||||||
-- | Run a compiler, yielding the resulting target and it's dependencies
|
-- | Run a compiler, yielding the resulting target and it's dependencies
|
||||||
--
|
--
|
||||||
runCompiler :: Compiler a -> Identifier -> (TargetM a a, Dependencies)
|
runCompiler :: Compiler a -> Identifier -> (TargetM a, Dependencies)
|
||||||
runCompiler compiler identifier = second compilerDependencies $
|
runCompiler compiler identifier = second compilerDependencies $
|
||||||
runState (runReaderT (unCompilerM compiler) env) state
|
runState (runReaderT (unCompilerM compiler) env) state
|
||||||
where
|
where
|
||||||
|
@ -69,15 +73,18 @@ runCompiler compiler identifier = second compilerDependencies $
|
||||||
-- | Require another target. Using this function ensures automatic handling of
|
-- | Require another target. Using this function ensures automatic handling of
|
||||||
-- dependencies
|
-- dependencies
|
||||||
--
|
--
|
||||||
require :: Identifier
|
require :: (Binary a, Typeable a, Writable a)
|
||||||
|
=> Identifier
|
||||||
-> Compiler a
|
-> Compiler a
|
||||||
require identifier = do
|
require identifier = do
|
||||||
addDependency identifier
|
addDependency identifier
|
||||||
return $ TargetM $ flip targetDependencyLookup identifier <$> ask
|
return $ TargetM $ do
|
||||||
|
lookup' <- targetDependencyLookup <$> ask
|
||||||
|
return $ unCompiledItem $ lookup' identifier
|
||||||
|
|
||||||
-- | Construct a target from a string, this string being the content of the
|
-- | Construct a target from a string, this string being the content of the
|
||||||
-- resource.
|
-- resource.
|
||||||
--
|
--
|
||||||
compileFromString :: (String -> TargetM a a) -- ^ Function to create the target
|
compileFromString :: (String -> TargetM a) -- ^ Function to create the target
|
||||||
-> Compiler a -- ^ Resulting compiler
|
-> Compiler a -- ^ Resulting compiler
|
||||||
compileFromString = return . (getResourceString >>=)
|
compileFromString = return . (getResourceString >>=)
|
||||||
|
|
|
@ -15,57 +15,69 @@ module Hakyll.Core.Rules
|
||||||
import Control.Applicative (Applicative, (<$>))
|
import Control.Applicative (Applicative, (<$>))
|
||||||
import Control.Monad.Writer
|
import Control.Monad.Writer
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Control.Arrow (second)
|
||||||
|
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
|
import Data.Binary (Binary)
|
||||||
|
|
||||||
import Hakyll.Core.ResourceProvider
|
import Hakyll.Core.ResourceProvider
|
||||||
import Hakyll.Core.Identifier
|
import Hakyll.Core.Identifier
|
||||||
import Hakyll.Core.Identifier.Pattern
|
import Hakyll.Core.Identifier.Pattern
|
||||||
import Hakyll.Core.Compiler
|
import Hakyll.Core.Compiler
|
||||||
import Hakyll.Core.Route
|
import Hakyll.Core.Route
|
||||||
|
import Hakyll.Core.CompiledItem
|
||||||
|
import Hakyll.Core.Writable
|
||||||
|
|
||||||
-- | A collection of rules for the compilation process
|
-- | A collection of rules for the compilation process
|
||||||
--
|
--
|
||||||
data RuleSet a = RuleSet
|
data RuleSet = RuleSet
|
||||||
{ rulesRoute :: Route
|
{ rulesRoute :: Route
|
||||||
, rulesCompilers :: [(Identifier, Compiler a)]
|
, rulesCompilers :: [(Identifier, Compiler CompiledItem)]
|
||||||
}
|
}
|
||||||
|
|
||||||
instance Monoid (RuleSet a) where
|
instance Monoid RuleSet where
|
||||||
mempty = RuleSet mempty mempty
|
mempty = RuleSet mempty mempty
|
||||||
mappend (RuleSet r1 c1) (RuleSet r2 c2) =
|
mappend (RuleSet r1 c1) (RuleSet r2 c2) =
|
||||||
RuleSet (mappend r1 r2) (mappend c1 c2)
|
RuleSet (mappend r1 r2) (mappend c1 c2)
|
||||||
|
|
||||||
-- | The monad used to compose rules
|
-- | The monad used to compose rules
|
||||||
--
|
--
|
||||||
newtype RulesM a b = RulesM
|
newtype RulesM a = RulesM
|
||||||
{ unRulesM :: ReaderT ResourceProvider (Writer (RuleSet a)) b
|
{ unRulesM :: ReaderT ResourceProvider (Writer RuleSet) a
|
||||||
} deriving (Monad, Functor, Applicative)
|
} deriving (Monad, Functor, Applicative)
|
||||||
|
|
||||||
-- | Simplification of the RulesM type; usually, it will not return any
|
-- | Simplification of the RulesM type; usually, it will not return any
|
||||||
-- result.
|
-- result.
|
||||||
--
|
--
|
||||||
type Rules a = RulesM a ()
|
type Rules = RulesM ()
|
||||||
|
|
||||||
-- | Run a Rules monad, resulting in a 'RuleSet'
|
-- | Run a Rules monad, resulting in a 'RuleSet'
|
||||||
--
|
--
|
||||||
runRules :: Rules a -> ResourceProvider -> RuleSet a
|
runRules :: Rules -> ResourceProvider -> RuleSet
|
||||||
runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
|
runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider
|
||||||
|
|
||||||
-- | Add a route
|
-- | Add a route
|
||||||
--
|
--
|
||||||
addRoute :: Route -> Rules a
|
addRoute :: Route -> Rules
|
||||||
addRoute route' = RulesM $ tell $ RuleSet route' mempty
|
addRoute route' = RulesM $ tell $ RuleSet route' mempty
|
||||||
|
|
||||||
-- | Add a number of compilers
|
-- | Add a number of compilers
|
||||||
--
|
--
|
||||||
addCompilers :: [(Identifier, Compiler a)] -> Rules a
|
addCompilers :: (Binary a, Typeable a, Writable a)
|
||||||
addCompilers compilers = RulesM $ tell $ RuleSet mempty compilers
|
=> [(Identifier, Compiler a)]
|
||||||
|
-> Rules
|
||||||
|
addCompilers compilers = RulesM $ tell $ RuleSet mempty $
|
||||||
|
map (second boxCompiler) compilers
|
||||||
|
where
|
||||||
|
boxCompiler = fmap (fmap compiledItem)
|
||||||
|
|
||||||
-- | Add a compilation rule
|
-- | Add a compilation rule
|
||||||
--
|
--
|
||||||
-- This instructs all resources matching the given pattern to be compiled using
|
-- This instructs all resources matching the given pattern to be compiled using
|
||||||
-- the given compiler
|
-- the given compiler
|
||||||
--
|
--
|
||||||
compile :: Pattern -> Compiler a -> Rules a
|
compile :: (Binary a, Typeable a, Writable a)
|
||||||
|
=> Pattern -> Compiler a -> Rules
|
||||||
compile pattern compiler = RulesM $ do
|
compile pattern compiler = RulesM $ do
|
||||||
identifiers <- matches pattern . resourceList <$> ask
|
identifiers <- matches pattern . resourceList <$> ask
|
||||||
unRulesM $ addCompilers $ zip identifiers (repeat compiler)
|
unRulesM $ addCompilers $ zip identifiers (repeat compiler)
|
||||||
|
@ -74,10 +86,11 @@ compile pattern compiler = RulesM $ do
|
||||||
--
|
--
|
||||||
-- This sets a compiler for the given identifier
|
-- This sets a compiler for the given identifier
|
||||||
--
|
--
|
||||||
create :: Identifier -> Compiler a -> RulesM a ()
|
create :: (Binary a, Typeable a, Writable a)
|
||||||
|
=> Identifier -> Compiler a -> Rules
|
||||||
create identifier compiler = addCompilers [(identifier, compiler)]
|
create identifier compiler = addCompilers [(identifier, compiler)]
|
||||||
|
|
||||||
-- | Add a route
|
-- | Add a route
|
||||||
--
|
--
|
||||||
route :: Pattern -> Route -> RulesM a ()
|
route :: Pattern -> Route -> Rules
|
||||||
route pattern route' = addRoute $ ifMatch pattern route'
|
route pattern route' = addRoute $ ifMatch pattern route'
|
||||||
|
|
|
@ -5,6 +5,9 @@ module Hakyll.Core.Run where
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import Control.Monad (foldM, forM_)
|
import Control.Monad (foldM, forM_)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import Data.Monoid (mempty)
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
|
import Data.Binary (Binary)
|
||||||
|
|
||||||
import Hakyll.Core.Route
|
import Hakyll.Core.Route
|
||||||
import Hakyll.Core.Compiler
|
import Hakyll.Core.Compiler
|
||||||
|
@ -16,14 +19,15 @@ import Hakyll.Core.DirectedGraph
|
||||||
import Hakyll.Core.DirectedGraph.DependencySolver
|
import Hakyll.Core.DirectedGraph.DependencySolver
|
||||||
import Hakyll.Core.Writable
|
import Hakyll.Core.Writable
|
||||||
import Hakyll.Core.Store
|
import Hakyll.Core.Store
|
||||||
|
import Hakyll.Core.CompiledItem
|
||||||
|
|
||||||
hakyll :: Writable a => Rules a -> IO ()
|
hakyll :: Rules -> IO ()
|
||||||
hakyll rules = do
|
hakyll rules = do
|
||||||
store <- makeStore "_store"
|
store <- makeStore "_store"
|
||||||
provider <- fileResourceProvider
|
provider <- fileResourceProvider
|
||||||
hakyllWith rules provider store
|
hakyllWith rules provider store
|
||||||
|
|
||||||
hakyllWith :: Writable a => Rules a -> ResourceProvider -> Store -> IO ()
|
hakyllWith :: Rules -> ResourceProvider -> Store -> IO ()
|
||||||
hakyllWith rules provider store = do
|
hakyllWith rules provider store = do
|
||||||
let -- Get the rule set
|
let -- Get the rule set
|
||||||
ruleSet = runRules rules provider
|
ruleSet = runRules rules provider
|
||||||
|
@ -48,22 +52,26 @@ hakyllWith rules provider store = do
|
||||||
-- Join the order with the targets again
|
-- Join the order with the targets again
|
||||||
orderedTargets = map (id &&& (targetMap M.!)) ordered
|
orderedTargets = map (id &&& (targetMap M.!)) ordered
|
||||||
|
|
||||||
-- Generate all the targets in order
|
-- Fetch the routes
|
||||||
map' <- foldM addTarget M.empty orderedTargets
|
|
||||||
|
|
||||||
let -- Fetch the routes
|
|
||||||
route' = rulesRoute ruleSet
|
route' = rulesRoute ruleSet
|
||||||
|
|
||||||
forM_ (M.toList map') $ \(id', result) ->
|
-- Generate all the targets in order
|
||||||
|
_ <- foldM (addTarget route') M.empty orderedTargets
|
||||||
|
|
||||||
|
putStrLn "DONE."
|
||||||
|
where
|
||||||
|
addTarget route' map' (id', targ) = do
|
||||||
|
compiled <- runTarget targ id' (dependencyLookup map') provider store
|
||||||
|
putStrLn $ "Generated target: " ++ show id'
|
||||||
|
|
||||||
case runRoute route' id' of
|
case runRoute route' id' of
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
Just r -> do
|
Just r -> do
|
||||||
putStrLn $ "Routing " ++ show id' ++ " to " ++ r
|
putStrLn $ "Routing " ++ show id' ++ " to " ++ r
|
||||||
write r result
|
write r compiled
|
||||||
|
|
||||||
putStrLn "DONE."
|
return $ M.insert id' compiled map'
|
||||||
where
|
|
||||||
addTarget map' (id', targ) = do
|
dependencyLookup map' id' = case M.lookup id' map' of
|
||||||
result <- runTarget targ id' (map' M.!) provider store
|
Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"
|
||||||
putStrLn $ "Generated target: " ++ show id'
|
Just d -> d
|
||||||
return $ M.insert id' result map'
|
|
||||||
|
|
|
@ -4,7 +4,6 @@
|
||||||
module Hakyll.Core.Target
|
module Hakyll.Core.Target
|
||||||
( DependencyLookup
|
( DependencyLookup
|
||||||
, TargetM
|
, TargetM
|
||||||
, Target
|
|
||||||
, runTarget
|
, runTarget
|
||||||
, getIdentifier
|
, getIdentifier
|
||||||
, getResourceString
|
, getResourceString
|
||||||
|
@ -20,12 +19,12 @@ import Hakyll.Core.ResourceProvider
|
||||||
|
|
||||||
-- | Get the current identifier
|
-- | Get the current identifier
|
||||||
--
|
--
|
||||||
getIdentifier :: TargetM a Identifier
|
getIdentifier :: TargetM Identifier
|
||||||
getIdentifier = TargetM $ targetIdentifier <$> ask
|
getIdentifier = TargetM $ targetIdentifier <$> ask
|
||||||
|
|
||||||
-- | Get the resource content as a string
|
-- | Get the resource content as a string
|
||||||
--
|
--
|
||||||
getResourceString :: TargetM a String
|
getResourceString :: TargetM String
|
||||||
getResourceString = TargetM $ do
|
getResourceString = TargetM $ do
|
||||||
provider <- targetResourceProvider <$> ask
|
provider <- targetResourceProvider <$> ask
|
||||||
identifier <- unTargetM getIdentifier
|
identifier <- unTargetM getIdentifier
|
||||||
|
|
|
@ -1,11 +1,10 @@
|
||||||
-- | Internal structure of a Target, not exported outside of the library
|
-- | Internal structure of a Target, not exported outside of the library
|
||||||
--
|
--
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}
|
||||||
module Hakyll.Core.Target.Internal
|
module Hakyll.Core.Target.Internal
|
||||||
( DependencyLookup
|
( DependencyLookup
|
||||||
, TargetEnvironment (..)
|
, TargetEnvironment (..)
|
||||||
, TargetM (..)
|
, TargetM (..)
|
||||||
, Target
|
|
||||||
, runTarget
|
, runTarget
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -17,18 +16,19 @@ import Control.Monad.State (StateT, evalStateT)
|
||||||
import Hakyll.Core.Identifier
|
import Hakyll.Core.Identifier
|
||||||
import Hakyll.Core.ResourceProvider
|
import Hakyll.Core.ResourceProvider
|
||||||
import Hakyll.Core.Store
|
import Hakyll.Core.Store
|
||||||
|
import Hakyll.Core.CompiledItem
|
||||||
|
|
||||||
-- | A lookup with which we can get dependencies
|
-- | A lookup with which we can get dependencies
|
||||||
--
|
--
|
||||||
type DependencyLookup a = Identifier -> a
|
type DependencyLookup = Identifier -> CompiledItem
|
||||||
|
|
||||||
-- | Environment for the target monad
|
-- | Environment for the target monad
|
||||||
--
|
--
|
||||||
data TargetEnvironment a = TargetEnvironment
|
data TargetEnvironment = TargetEnvironment
|
||||||
{ targetIdentifier :: Identifier -- ^ Identifier
|
{ targetIdentifier :: Identifier -- ^ Identifier
|
||||||
, targetDependencyLookup :: DependencyLookup a -- ^ Dependency lookup
|
, targetDependencyLookup :: DependencyLookup -- ^ Dependency lookup
|
||||||
, targetResourceProvider :: ResourceProvider -- ^ To get resources
|
, targetResourceProvider :: ResourceProvider -- ^ To get resources
|
||||||
, targetStore :: Store -- ^ Store for caching
|
, targetStore :: Store -- ^ Store for caching
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | State for the target monad
|
-- | State for the target monad
|
||||||
|
@ -40,20 +40,15 @@ data TargetState = TargetState
|
||||||
-- | Monad for targets. In this monad, the user can compose targets and describe
|
-- | Monad for targets. In this monad, the user can compose targets and describe
|
||||||
-- how they should be created.
|
-- how they should be created.
|
||||||
--
|
--
|
||||||
newtype TargetM a b = TargetM
|
newtype TargetM a = TargetM
|
||||||
{ unTargetM :: ReaderT (TargetEnvironment a) (StateT TargetState IO) b
|
{ unTargetM :: ReaderT TargetEnvironment (StateT TargetState IO) a
|
||||||
} deriving (Monad, Functor, Applicative, MonadIO)
|
} deriving (Monad, Functor, Applicative, MonadIO)
|
||||||
|
|
||||||
-- | Simplification of the 'TargetM' type for concrete cases: the type of the
|
|
||||||
-- returned item should equal the type of the dependencies.
|
|
||||||
--
|
|
||||||
type Target a = TargetM a a
|
|
||||||
|
|
||||||
-- | Run a target, yielding an actual result.
|
-- | Run a target, yielding an actual result.
|
||||||
--
|
--
|
||||||
runTarget :: Target a
|
runTarget :: TargetM a
|
||||||
-> Identifier
|
-> Identifier
|
||||||
-> DependencyLookup a
|
-> DependencyLookup
|
||||||
-> ResourceProvider
|
-> ResourceProvider
|
||||||
-> Store
|
-> Store
|
||||||
-> IO a
|
-> IO a
|
||||||
|
|
|
@ -51,5 +51,5 @@ fileType = fileType' . takeExtension
|
||||||
|
|
||||||
-- | Get the file type for the current file
|
-- | Get the file type for the current file
|
||||||
--
|
--
|
||||||
getFileType :: TargetM a FileType
|
getFileType :: TargetM FileType
|
||||||
getFileType = fileType . toFilePath <$> getIdentifier
|
getFileType = fileType . toFilePath <$> getIdentifier
|
||||||
|
|
|
@ -2,6 +2,7 @@
|
||||||
-- type 'String') and number of metadata fields. This type is used to represent
|
-- type 'String') and number of metadata fields. This type is used to represent
|
||||||
-- pages on your website.
|
-- pages on your website.
|
||||||
--
|
--
|
||||||
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
module Hakyll.Web.Page
|
module Hakyll.Web.Page
|
||||||
( Page (..)
|
( Page (..)
|
||||||
, toMap
|
, toMap
|
||||||
|
@ -12,6 +13,7 @@ import Control.Applicative ((<$>), (<*>))
|
||||||
import Data.Map (Map)
|
import Data.Map (Map)
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
import Data.Binary (Binary, get, put)
|
import Data.Binary (Binary, get, put)
|
||||||
|
import Data.Typeable (Typeable)
|
||||||
|
|
||||||
import Hakyll.Core.Writable
|
import Hakyll.Core.Writable
|
||||||
|
|
||||||
|
@ -20,7 +22,7 @@ import Hakyll.Core.Writable
|
||||||
data Page a = Page
|
data Page a = Page
|
||||||
{ pageMetadata :: Map String String
|
{ pageMetadata :: Map String String
|
||||||
, pageBody :: a
|
, pageBody :: a
|
||||||
}
|
} deriving (Show, Typeable)
|
||||||
|
|
||||||
instance Functor Page where
|
instance Functor Page where
|
||||||
fmap f (Page m b) = Page m (f b)
|
fmap f (Page m b) = Page m (f b)
|
||||||
|
|
|
@ -29,9 +29,9 @@ import Hakyll.Web.Page
|
||||||
|
|
||||||
-- | Read a string using pandoc, with the default options
|
-- | Read a string using pandoc, with the default options
|
||||||
--
|
--
|
||||||
readPandoc :: FileType -- ^ File type, determines how parsing happens
|
readPandoc :: FileType -- ^ File type, determines how parsing happens
|
||||||
-> String -- ^ String to read
|
-> String -- ^ String to read
|
||||||
-> Pandoc -- ^ Resulting document
|
-> Pandoc -- ^ Resulting document
|
||||||
readPandoc = readPandocWith defaultParserState
|
readPandoc = readPandocWith defaultParserState
|
||||||
|
|
||||||
-- | Read a string using pandoc, with the supplied options
|
-- | Read a string using pandoc, with the supplied options
|
||||||
|
@ -51,8 +51,8 @@ readPandocWith state fileType' = case fileType' of
|
||||||
|
|
||||||
-- | Write a document (as HTML) using pandoc, with the default options
|
-- | Write a document (as HTML) using pandoc, with the default options
|
||||||
--
|
--
|
||||||
writePandoc :: Pandoc -- ^ Document to write
|
writePandoc :: Pandoc -- ^ Document to write
|
||||||
-> String -- ^ Resulting HTML
|
-> String -- ^ Resulting HTML
|
||||||
writePandoc = writePandocWith defaultWriterOptions
|
writePandoc = writePandocWith defaultWriterOptions
|
||||||
|
|
||||||
-- | Write a document (as HTML) using pandoc, with the supplied options
|
-- | Write a document (as HTML) using pandoc, with the supplied options
|
||||||
|
@ -64,19 +64,19 @@ writePandocWith = P.writeHtmlString
|
||||||
|
|
||||||
-- | Read the resource using pandoc
|
-- | Read the resource using pandoc
|
||||||
--
|
--
|
||||||
pageReadPandoc :: Page String -> TargetM a (Page Pandoc)
|
pageReadPandoc :: Page String -> TargetM (Page Pandoc)
|
||||||
pageReadPandoc = pageReadPandocWith defaultParserState
|
pageReadPandoc = pageReadPandocWith defaultParserState
|
||||||
|
|
||||||
-- | Read the resource using pandoc
|
-- | Read the resource using pandoc
|
||||||
--
|
--
|
||||||
pageReadPandocWith :: P.ParserState -> Page String -> TargetM a (Page Pandoc)
|
pageReadPandocWith :: P.ParserState -> Page String -> TargetM (Page Pandoc)
|
||||||
pageReadPandocWith state page = do
|
pageReadPandocWith state page = do
|
||||||
fileType' <- getFileType
|
fileType' <- getFileType
|
||||||
return $ readPandocWith state fileType' <$> page
|
return $ readPandocWith state fileType' <$> page
|
||||||
|
|
||||||
-- | Render the resource using pandoc
|
-- | Render the resource using pandoc
|
||||||
--
|
--
|
||||||
pageRenderPandoc :: Page String -> TargetM a (Page String)
|
pageRenderPandoc :: Page String -> TargetM (Page String)
|
||||||
pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions
|
pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions
|
||||||
|
|
||||||
-- | Render the resource using pandoc
|
-- | Render the resource using pandoc
|
||||||
|
@ -84,7 +84,7 @@ pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions
|
||||||
pageRenderPandocWith :: P.ParserState
|
pageRenderPandocWith :: P.ParserState
|
||||||
-> P.WriterOptions
|
-> P.WriterOptions
|
||||||
-> Page String
|
-> Page String
|
||||||
-> TargetM a (Page String)
|
-> TargetM (Page String)
|
||||||
pageRenderPandocWith state options page = do
|
pageRenderPandocWith state options page = do
|
||||||
pandoc <- pageReadPandocWith state page
|
pandoc <- pageReadPandocWith state page
|
||||||
return $ writePandocWith options <$> pandoc
|
return $ writePandocWith options <$> pandoc
|
||||||
|
|
Loading…
Reference in a new issue