Move src/ to lib/, put Init.hs in src/

3 files changed, 0 insertions, 415 deletions

diff --git a/src/Hakyll/Core/Provider/Internal.hs b/src/Hakyll/Core/Provider/Internal.hs
deleted file mode 100644
index c298653..0000000
--- a/src/Hakyll/Core/Provider/Internal.hs
+++ /dev/null
@@ -1,202 +0,0 @@
---------------------------------------------------------------------------------
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE DeriveDataTypeable         #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Hakyll.Core.Provider.Internal
-    ( ResourceInfo (..)
-    , Provider (..)
-    , newProvider
-
-    , resourceList
-    , resourceExists
-
-    , resourceFilePath
-    , resourceString
-    , resourceLBS
-
-    , resourceModified
-    , resourceModificationTime
-    ) where
-
-
---------------------------------------------------------------------------------
-import           Control.DeepSeq        (NFData (..), deepseq)
-import           Control.Monad          (forM)
-import           Data.Binary            (Binary (..))
-import qualified Data.ByteString.Lazy   as BL
-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.Time              (Day (..), UTCTime (..))
-import           Data.Typeable          (Typeable)
-import           System.Directory       (getModificationTime)
-import           System.FilePath        (addExtension, (</>))
-
-
---------------------------------------------------------------------------------
-#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.Store      (Store)
-import qualified Hakyll.Core.Store      as Store
-import           Hakyll.Core.Util.File
-
-
---------------------------------------------------------------------------------
--- | Because UTCTime doesn't have a Binary instance...
-newtype BinaryTime = BinaryTime {unBinaryTime :: UTCTime}
-    deriving (Eq, NFData, Ord, Show, Typeable)
-
-
---------------------------------------------------------------------------------
-instance Binary BinaryTime where
-    put (BinaryTime (UTCTime (ModifiedJulianDay d) dt)) =
-        put d >> put (toRational dt)
-
-    get = fmap BinaryTime $ UTCTime
-        <$> (ModifiedJulianDay <$> get)
-        <*> (fromRational <$> get)
-
-
---------------------------------------------------------------------------------
-data ResourceInfo = ResourceInfo
-    { resourceInfoModified :: BinaryTime
-    , resourceInfoMetadata :: Maybe Identifier
-    } deriving (Show, Typeable)
-
-
---------------------------------------------------------------------------------
-instance Binary ResourceInfo where
-    put (ResourceInfo mtime meta) = put mtime >> put meta
-    get = ResourceInfo <$> get <*> get
-
-
---------------------------------------------------------------------------------
-instance NFData ResourceInfo where
-    rnf (ResourceInfo mtime meta) = rnf mtime `seq` rnf meta `seq` ()
-
-
---------------------------------------------------------------------------------
--- | Responsible for retrieving and listing resources
-data Provider = Provider
-    { -- Top of the provided directory
-      providerDirectory :: FilePath
-    , -- | A list of all files found
-      providerFiles     :: Map Identifier ResourceInfo
-    , -- | A list of the files from the previous run
-      providerOldFiles  :: Map Identifier ResourceInfo
-    , -- | Underlying persistent store for caching
-      providerStore     :: Store
-    } deriving (Show)
-
-
---------------------------------------------------------------------------------
--- | Create a resource provider
-newProvider :: Store                  -- ^ Store to use
-            -> (FilePath -> IO Bool)  -- ^ Should we ignore this file?
-            -> FilePath               -- ^ Search directory
-            -> IO Provider            -- ^ Resulting provider
-newProvider store ignore directory = do
-    list <- map fromFilePath <$> getRecursiveContents ignore directory
-    let universe = S.fromList list
-    files <- fmap (maxmtime . M.fromList) $ forM list $ \identifier -> do
-        rInfo <- getResourceInfo directory universe identifier
-        return (identifier, rInfo)
-
-    -- Get the old files from the store, and then immediately replace them by
-    -- the new files.
-    oldFiles <- fromMaybe mempty . Store.toMaybe <$> Store.get store oldKey
-    oldFiles `deepseq` Store.set store oldKey files
-
-    return $ Provider directory files oldFiles store
-  where
-    oldKey = ["Hakyll.Core.Provider.Internal.newProvider", "oldFiles"]
-
-    -- Update modified if metadata is modified
-    maxmtime files = flip M.map files $ \rInfo@(ResourceInfo mtime meta) ->
-        let metaMod = fmap resourceInfoModified $ meta >>= flip M.lookup files
-        in rInfo {resourceInfoModified = maybe mtime (max mtime) metaMod}
-
-
---------------------------------------------------------------------------------
-getResourceInfo :: FilePath -> Set Identifier -> Identifier -> IO ResourceInfo
-getResourceInfo directory universe identifier = do
-    mtime <- fileModificationTime $ directory </> toFilePath identifier
-    return $ ResourceInfo (BinaryTime mtime) $
-        if mdRsc `S.member` universe then Just mdRsc else Nothing
-  where
-    mdRsc = fromFilePath $ flip addExtension "metadata" $ toFilePath identifier
-
-
---------------------------------------------------------------------------------
-resourceList :: Provider -> [Identifier]
-resourceList = M.keys . providerFiles
-
-
---------------------------------------------------------------------------------
--- | Check if a given resource exists
-resourceExists :: Provider -> Identifier -> Bool
-resourceExists provider =
-    (`M.member` providerFiles provider) . setVersion Nothing
-
-
---------------------------------------------------------------------------------
-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
-
-
---------------------------------------------------------------------------------
--- | A resource is modified if it or its metadata has changed
-resourceModified :: Provider -> Identifier -> Bool
-resourceModified p r = case (ri, oldRi) of
-    (Nothing, _)      -> False
-    (Just _, Nothing) -> True
-    (Just n, Just o)  ->
-        resourceInfoModified n >  resourceInfoModified o ||
-        resourceInfoMetadata n /= resourceInfoMetadata o
-  where
-    normal = setVersion Nothing r
-    ri     = M.lookup normal (providerFiles p)
-    oldRi  = M.lookup normal (providerOldFiles p)
-
-
---------------------------------------------------------------------------------
-resourceModificationTime :: Provider -> Identifier -> UTCTime
-resourceModificationTime p i =
-    case M.lookup (setVersion Nothing i) (providerFiles p) of
-        Just ri -> unBinaryTime $ resourceInfoModified ri
-        Nothing -> error $
-            "Hakyll.Core.Provider.Internal.resourceModificationTime: " ++
-            "resource " ++ show i ++ " does not exist"
-
-
---------------------------------------------------------------------------------
-fileModificationTime :: FilePath -> IO UTCTime
-fileModificationTime fp = do
-#if MIN_VERSION_directory(1,2,0)
-    getModificationTime fp
-#else
-    ct <- toCalendarTime =<< getModificationTime fp
-    let str = formatCalendarTime defaultTimeLocale "%s" ct
-    return $ readTime defaultTimeLocale "%s" str
-#endif
diff --git a/src/Hakyll/Core/Provider/Metadata.hs b/src/Hakyll/Core/Provider/Metadata.hs
deleted file mode 100644
index 6285ce1..0000000
--- a/src/Hakyll/Core/Provider/Metadata.hs
+++ /dev/null
@@ -1,151 +0,0 @@
---------------------------------------------------------------------------------
--- | Internal module to parse metadata
-{-# LANGUAGE BangPatterns    #-}
-{-# LANGUAGE RecordWildCards #-}
-module Hakyll.Core.Provider.Metadata
-    ( loadMetadata
-    , parsePage
-
-    , MetadataException (..)
-    ) where
-
-
---------------------------------------------------------------------------------
-import           Control.Arrow                 (second)
-import           Control.Exception             (Exception, throwIO)
-import           Control.Monad                 (guard)
-import qualified Data.ByteString               as B
-import qualified Data.ByteString.Char8         as BC
-import           Data.List.Extended            (breakWhen)
-import qualified Data.Map                      as M
-import           Data.Maybe                    (fromMaybe)
-import           Data.Monoid                   ((<>))
-import qualified Data.Text                     as T
-import qualified Data.Text.Encoding            as T
-import qualified Data.Yaml                     as Yaml
-import           Hakyll.Core.Identifier
-import           Hakyll.Core.Metadata
-import           Hakyll.Core.Provider.Internal
-import           System.IO                     as IO
-
-
---------------------------------------------------------------------------------
-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 (mempty, Nothing)
-
-    emd <- case mi of
-        Nothing  -> return mempty
-        Just mi' -> loadMetadataFile $ resourceFilePath p mi'
-
-    return (md <> emd, body)
-  where
-    normal = setVersion Nothing identifier
-    fp     = resourceFilePath p identifier
-    mi     = M.lookup normal (providerFiles p) >>= resourceInfoMetadata
-
-
---------------------------------------------------------------------------------
-loadMetadataHeader :: FilePath -> IO (Metadata, String)
-loadMetadataHeader fp = do
-    fileContent <- readFile fp
-    case parsePage fileContent of
-        Right x   -> return x
-        Left  err -> throwIO $ MetadataException fp err
-
-
---------------------------------------------------------------------------------
-loadMetadataFile :: FilePath -> IO Metadata
-loadMetadataFile fp = do
-    fileContent <- B.readFile fp
-    let errOrMeta = Yaml.decodeEither' fileContent
-    either (fail . show) return errOrMeta
-
-
---------------------------------------------------------------------------------
--- | 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
-
-
---------------------------------------------------------------------------------
--- | Parse the page metadata and body.
-splitMetadata :: String -> (Maybe String, String)
-splitMetadata str0 = fromMaybe (Nothing, str0) $ do
-    guard $ leading >= 3
-    let !str1 = drop leading str0
-    guard $ all isNewline (take 1 str1)
-    let !(!meta, !content0) = breakWhen isTrailing str1
-    guard $ not $ null content0
-    let !content1 = drop (leading + 1) content0
-        !content2 = dropWhile isNewline $ dropWhile isInlineSpace content1
-    -- Adding this newline fixes the line numbers reported by the YAML parser.
-    -- It's a bit ugly but it works.
-    return (Just ('\n' : meta), content2)
-  where
-    -- Parse the leading "---"
-    !leading = length $ takeWhile (== '-') str0
-
-    -- Predicate to recognize the trailing "---" or "..."
-    isTrailing []       = False
-    isTrailing (x : xs) =
-        isNewline x && length (takeWhile isDash xs) == leading
-
-    -- Characters
-    isNewline     c = c == '\n' || c == '\r'
-    isDash        c = c == '-'  || c == '.'
-    isInlineSpace c = c == '\t' || c == ' '
-
-
---------------------------------------------------------------------------------
-parseMetadata :: String -> Either Yaml.ParseException Metadata
-parseMetadata = Yaml.decodeEither' . T.encodeUtf8 . T.pack
-
-
---------------------------------------------------------------------------------
-parsePage :: String -> Either Yaml.ParseException (Metadata, String)
-parsePage fileContent = case mbMetaBlock of
-    Nothing        -> return (mempty, content)
-    Just metaBlock -> case parseMetadata metaBlock of
-        Left  err  -> Left   err
-        Right meta -> return (meta, content)
-  where
-    !(!mbMetaBlock, !content) = splitMetadata fileContent
-
-
---------------------------------------------------------------------------------
--- | Thrown in the IO monad if things go wrong. Provides a nice-ish error
--- message.
-data MetadataException = MetadataException FilePath Yaml.ParseException
-
-
---------------------------------------------------------------------------------
-instance Exception MetadataException
-
-
---------------------------------------------------------------------------------
-instance Show MetadataException where
-    show (MetadataException fp err) =
-        fp ++ ": " ++ Yaml.prettyPrintParseException err ++ hint
-
-      where
-        hint = case err of
-            Yaml.InvalidYaml (Just (Yaml.YamlParseException {..}))
-                | yamlProblem == problem -> "\n" ++
-                    "Hint: if the metadata value contains characters such\n" ++
-                    "as ':' or '-', try enclosing it in quotes."
-            _ -> ""
-
-        problem = "mapping values are not allowed in this context"
diff --git a/src/Hakyll/Core/Provider/MetadataCache.hs b/src/Hakyll/Core/Provider/MetadataCache.hs
deleted file mode 100644
index 46dbf3e..0000000
--- a/src/Hakyll/Core/Provider/MetadataCache.hs
+++ /dev/null
@@ -1,62 +0,0 @@
---------------------------------------------------------------------------------
-module Hakyll.Core.Provider.MetadataCache
-    ( resourceMetadata
-    , resourceBody
-    , resourceInvalidateMetadataCache
-    ) where
-
-
---------------------------------------------------------------------------------
-import           Control.Monad                 (unless)
-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 mempty
-    | otherwise                = do
-        -- TODO keep time in md cache
-        load p r
-        Store.Found (BinaryMetadata 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
-    mmof <- Store.isMember store mdk
-    unless mmof $ do
-        (md, body) <- loadMetadata p r
-        Store.set store mdk (BinaryMetadata md)
-        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"