--------------------------------------------------------------------------------
-- | 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.
--
-- Suppose we have an item @foo\/bar.markdown@. We can render this to
-- @foo\/bar.html@ using:
--
-- > route "foo/bar.markdown" (setExtension ".html")
--
-- If we do not want to change the extension, we can use 'idRoute', the simplest
-- route available:
--
-- > route "foo/bar.markdown" idRoute
--
-- That will route @foo\/bar.markdown@ to @foo\/bar.markdown@.
--
-- Note that the extension says nothing about the content! If you set the
-- extension to @.html@, it is your own responsibility to ensure that the
-- content is indeed HTML.
--
-- Finally, some special cases:
--
-- * If there is no route for an item, this item will not be routed, so it will
--   not appear in your site directory.
--
-- * If an item matches multiple routes, the first rule will be chosen.
{-# LANGUAGE CPP        #-}
{-# LANGUAGE Rank2Types #-}
module Hakyll.Core.Routes
    ( UsedMetadata
    , Routes
    , runRoutes
    , idRoute
    , setExtension
    , matchRoute
    , customRoute
    , constRoute
    , gsubRoute
    , metadataRoute
    , composeRoutes
    ) where


--------------------------------------------------------------------------------
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup                 (Semigroup (..))
#endif
import           System.FilePath                (replaceExtension, normalise)


--------------------------------------------------------------------------------
import           Hakyll.Core.Identifier
import           Hakyll.Core.Identifier.Pattern
import           Hakyll.Core.Metadata
import           Hakyll.Core.Provider
import           Hakyll.Core.Util.String


--------------------------------------------------------------------------------
-- | When you ran a route, it's useful to know whether or not this used
-- metadata. This allows us to do more granular dependency analysis.
type UsedMetadata = Bool


--------------------------------------------------------------------------------
data RoutesRead = RoutesRead
    { RoutesRead -> Provider
routesProvider   :: Provider
    , RoutesRead -> Identifier
routesUnderlying :: Identifier
    }


--------------------------------------------------------------------------------
-- | Type used for a route
newtype Routes = Routes
    { Routes
-> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
unRoutes :: RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
    }


--------------------------------------------------------------------------------
#if MIN_VERSION_base(4,9,0)
instance Semigroup Routes where
    <> :: Routes -> Routes -> Routes
(<>) (Routes RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
f) (Routes RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
g) = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ \RoutesRead
p Identifier
id' -> do
        (Maybe FilePath
mfp, UsedMetadata
um) <- RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
f RoutesRead
p Identifier
id'
        case Maybe FilePath
mfp of
            Maybe FilePath
Nothing -> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
g RoutesRead
p Identifier
id'
            Just FilePath
_  -> (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
mfp, UsedMetadata
um)

instance Monoid Routes where
    mempty :: Routes
mempty  = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ \RoutesRead
_ Identifier
_ -> (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
forall a. Maybe a
Nothing, UsedMetadata
False)
    mappend :: Routes -> Routes -> Routes
mappend = Routes -> Routes -> Routes
forall a. Semigroup a => a -> a -> a
(<>)
#else
instance Monoid Routes where
    mempty = Routes $ \_ _ -> return (Nothing, False)
    mappend (Routes f) (Routes g) = Routes $ \p id' -> do
        (mfp, um) <- f p id'
        case mfp of
            Nothing -> g p id'
            Just _  -> return (mfp, um)
#endif


--------------------------------------------------------------------------------
-- | Apply a route to an identifier
runRoutes :: Routes -> Provider -> Identifier
          -> IO (Maybe FilePath, UsedMetadata)
runRoutes :: Routes
-> Provider -> Identifier -> IO (Maybe FilePath, UsedMetadata)
runRoutes Routes
routes Provider
provider Identifier
identifier =
    Routes
-> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
unRoutes Routes
routes (Provider -> Identifier -> RoutesRead
RoutesRead Provider
provider Identifier
identifier) Identifier
identifier


--------------------------------------------------------------------------------
-- | 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
idRoute = (Identifier -> FilePath) -> Routes
customRoute Identifier -> FilePath
toFilePath


--------------------------------------------------------------------------------
-- | Set (or replace) the extension of a route.
--
-- Example:
--
-- > runRoutes (setExtension "html") "foo/bar"
--
-- Result:
--
-- > Just "foo/bar.html"
--
-- Example:
--
-- > runRoutes (setExtension "html") "posts/the-art-of-trolling.markdown"
--
-- Result:
--
-- > Just "posts/the-art-of-trolling.html"
setExtension :: String -> Routes
setExtension :: FilePath -> Routes
setExtension FilePath
extension = (Identifier -> FilePath) -> Routes
customRoute ((Identifier -> FilePath) -> Routes)
-> (Identifier -> FilePath) -> Routes
forall a b. (a -> b) -> a -> b
$
    (FilePath -> FilePath -> FilePath
`replaceExtension` FilePath
extension) (FilePath -> FilePath)
-> (Identifier -> FilePath) -> Identifier -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> FilePath
toFilePath


--------------------------------------------------------------------------------
-- | Apply the route if the identifier matches the given pattern, fail
-- otherwise
matchRoute :: Pattern -> Routes -> Routes
matchRoute :: Pattern -> Routes -> Routes
matchRoute Pattern
pattern (Routes RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
route) = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ \RoutesRead
p Identifier
id' ->
    if Pattern -> Identifier -> UsedMetadata
matches Pattern
pattern Identifier
id' then RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
route RoutesRead
p Identifier
id' else (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
forall a. Maybe a
Nothing, UsedMetadata
False)


--------------------------------------------------------------------------------
-- | Create a custom route. This should almost always be used with
-- 'matchRoute'
customRoute :: (Identifier -> FilePath) -> Routes
customRoute :: (Identifier -> FilePath) -> Routes
customRoute Identifier -> FilePath
f = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ (Identifier -> IO (Maybe FilePath, UsedMetadata))
-> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
forall a b. a -> b -> a
const ((Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> (Identifier -> IO (Maybe FilePath, UsedMetadata))
-> RoutesRead
-> Identifier
-> IO (Maybe FilePath, UsedMetadata)
forall a b. (a -> b) -> a -> b
$ \Identifier
id' -> (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (Identifier -> FilePath
f Identifier
id'), UsedMetadata
False)


--------------------------------------------------------------------------------
-- | A route that always gives the same result. Obviously, you should only use
-- this for a single compilation rule.
constRoute :: FilePath -> Routes
constRoute :: FilePath -> Routes
constRoute = (Identifier -> FilePath) -> Routes
customRoute ((Identifier -> FilePath) -> Routes)
-> (FilePath -> Identifier -> FilePath) -> FilePath -> Routes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Identifier -> FilePath
forall a b. a -> b -> a
const


--------------------------------------------------------------------------------
-- | Create a gsub route
--
-- Example:
--
-- > runRoutes (gsubRoute "rss/" (const "")) "tags/rss/bar.xml"
--
-- Result:
--
-- > Just "tags/bar.xml"
gsubRoute :: String              -- ^ Pattern
          -> (String -> String)  -- ^ Replacement
          -> Routes              -- ^ Resulting route
gsubRoute :: FilePath -> (FilePath -> FilePath) -> Routes
gsubRoute FilePath
pattern FilePath -> FilePath
replacement = (Identifier -> FilePath) -> Routes
customRoute ((Identifier -> FilePath) -> Routes)
-> (Identifier -> FilePath) -> Routes
forall a b. (a -> b) -> a -> b
$
    FilePath -> FilePath
normalise (FilePath -> FilePath)
-> (Identifier -> FilePath) -> Identifier -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath -> FilePath) -> FilePath -> FilePath
replaceAll FilePath
pattern (FilePath -> FilePath
replacement (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
removeWinPathSeparator) (FilePath -> FilePath)
-> (Identifier -> FilePath) -> Identifier -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
removeWinPathSeparator (FilePath -> FilePath)
-> (Identifier -> FilePath) -> Identifier -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> FilePath
toFilePath
    where
        -- Filepaths on Windows containing `\\' will trip Regex matching, which
        -- is used in replaceAll. We normalise filepaths to have '/' as a path separator
        -- using removeWinPathSeparator


--------------------------------------------------------------------------------
-- | Get access to the metadata in order to determine the route
metadataRoute :: (Metadata -> Routes) -> Routes
metadataRoute :: (Metadata -> Routes) -> Routes
metadataRoute Metadata -> Routes
f = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ \RoutesRead
r Identifier
i -> do
    Metadata
metadata <- Provider -> Identifier -> IO Metadata
resourceMetadata (RoutesRead -> Provider
routesProvider RoutesRead
r) (RoutesRead -> Identifier
routesUnderlying RoutesRead
r)
    Routes
-> RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
unRoutes (Metadata -> Routes
f Metadata
metadata) RoutesRead
r Identifier
i


--------------------------------------------------------------------------------
-- | Compose routes so that @f \`composeRoutes\` g@ is more or less equivalent
-- with @g . f@.
--
-- Example:
--
-- > let routes = gsubRoute "rss/" (const "") `composeRoutes` setExtension "xml"
-- > in runRoutes routes "tags/rss/bar"
--
-- Result:
--
-- > 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 -> Routes -> Routes
composeRoutes (Routes RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
f) (Routes RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
g) = (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
Routes ((RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
 -> Routes)
-> (RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata))
-> Routes
forall a b. (a -> b) -> a -> b
$ \RoutesRead
p Identifier
i -> do
    (Maybe FilePath
mfp, UsedMetadata
um) <- RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
f RoutesRead
p Identifier
i
    case Maybe FilePath
mfp of
        Maybe FilePath
Nothing -> (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
forall a. Maybe a
Nothing, UsedMetadata
um)
        Just FilePath
fp -> do
            (Maybe FilePath
mfp', UsedMetadata
um') <- RoutesRead -> Identifier -> IO (Maybe FilePath, UsedMetadata)
g RoutesRead
p (FilePath -> Identifier
fromFilePath FilePath
fp)
            (Maybe FilePath, UsedMetadata) -> IO (Maybe FilePath, UsedMetadata)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
mfp', UsedMetadata
um UsedMetadata -> UsedMetadata -> UsedMetadata
|| UsedMetadata
um')