hakyll 3.0.1.4 → 3.0.2.0

raw patch · 10 files changed

+111/−76 lines, 10 filesdep +HTTPPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HTTP

API changes (from Hackage documentation)

Files

• hakyll.cabal +2/−1
• src/Hakyll/Core/CompiledItem.hs +2/−1
• src/Hakyll/Core/DirectedGraph.hs +8/−0
• src/Hakyll/Core/DirectedGraph/Internal.hs +11/−2
• src/Hakyll/Core/Identifier.hs +8/−6
• src/Hakyll/Core/Identifier/Pattern.hs +41/−50
• src/Hakyll/Core/Run.hs +8/−4
• src/Hakyll/Core/Store.hs +13/−11
• src/Hakyll/Web/Page/Metadata.hs +16/−0
• src/Hakyll/Web/Preview/Server.hs +2/−1

@@ -1,5 +1,5 @@ Name:               hakyll-Version:            3.0.1.4+Version:            3.0.2.0  Synopsis:           A simple static site generator library. Description:        A simple static site generator library, mainly aimed at@@ -59,6 +59,7 @@                       snap-core >= 0.4,                       bytestring >= 0.9,                       utf8-string >= 0.3,+                      HTTP >= 4000,                       tagsoup >= 0.12,                       hopenssl >= 1.4,                       unix >= 2.4,

@@ -7,7 +7,7 @@ -- -- * we need a 'Writable' instance so the results can be saved. ---{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable #-} module Hakyll.Core.CompiledItem     ( CompiledItem (..)     , compiledItem@@ -24,6 +24,7 @@ -- 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

@@ -4,6 +4,7 @@ module Hakyll.Core.DirectedGraph     ( DirectedGraph     , fromList+    , toList     , member     , nodes     , neighbours@@ -13,6 +14,7 @@     ) where  import Prelude hiding (reverse)+import Control.Arrow (second) import Data.Monoid (mconcat) import Data.Set (Set) import Data.Maybe (fromMaybe)@@ -27,6 +29,12 @@          => [(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 --

@@ -1,25 +1,34 @@ -- | 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)+    } 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@@ -33,7 +42,7 @@ -- | Type used to represent a directed graph -- newtype DirectedGraph a = DirectedGraph {unDirectedGraph :: Map a (Node a)}-                        deriving (Show)+                        deriving (Show, Binary, Typeable)  -- | Allow users to concatenate different graphs --

@@ -20,7 +20,7 @@ -- @posts/foo.html@. In this case, the identifier is the name of the source -- file of the page. ---{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-} module Hakyll.Core.Identifier     ( Identifier (..)     , parseIdentifier@@ -29,14 +29,16 @@  import Control.Arrow (second) import Data.Monoid (Monoid)+import Data.List (intercalate) +import Data.Binary (Binary) import GHC.Exts (IsString, fromString)-import System.FilePath (joinPath)+import Data.Typeable (Typeable)  -- | An identifier used to uniquely identify a value ---newtype Identifier = Identifier {unIdentifier :: [String]}-                   deriving (Eq, Ord, Monoid)+newtype Identifier = Identifier {unIdentifier :: String}+                   deriving (Eq, Ord, Monoid, Binary, Typeable)  instance Show Identifier where     show = toFilePath@@ -47,7 +49,7 @@ -- | Parse an identifier from a string -- parseIdentifier :: String -> Identifier-parseIdentifier = Identifier . filter (not . null) . split'+parseIdentifier = Identifier . intercalate "/" . filter (not . null) . split'   where     split' [] = [[]]     split' str = let (pre, post) = second (drop 1) $ break (== '/') str@@ -56,4 +58,4 @@ -- | Convert an identifier to a relative 'FilePath' -- toFilePath :: Identifier -> FilePath-toFilePath = joinPath . unIdentifier+toFilePath = unIdentifier

@@ -6,27 +6,22 @@ -- To match more than one identifier, there are different captures that one can -- use: ----- * @*@: matches exactly one element of an identifier;+-- * @*@: matches at most one element 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@ nor---   @foo@;+-- * @foo\/*@ will match @foo\/bar@ and @foo\/foo@, but not @foo\/bar\/qux@; ----- * @**@ will match any non-empty identifier;+-- * @**@ will match any identifier; ----- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@ nor---   @foo@;+-- * @foo\/**@ will match @foo\/bar@ and @foo\/bar\/qux@, but not @bar\/foo@; ----- A small warning: patterns are not globs. Using @foo\/*.markdown@ will not do--- what you probably intended, as it will only match the file which is literally--- called @foo\/*.markdown@. Remember that these captures only work on elements--- of identifiers as a whole; not on parts of these elements.+-- * @foo\/*.html@ will match all HTML files in the @foo\/@ directory. ----- Furthermore, the 'match' function allows the user to get access to the--- elements captured by the capture elements in the pattern.+-- The 'match' function allows the user to get access to the elements captured+-- by the capture elements in the pattern. -- module Hakyll.Core.Identifier.Pattern     ( Pattern@@ -39,7 +34,8 @@     , fromCaptures     ) where -import Data.List (intercalate)+import Data.List (isPrefixOf, inits, tails)+import Control.Arrow ((&&&), (>>>)) import Control.Monad (msum) import Data.Maybe (isJust) import Data.Monoid (mempty, mappend)@@ -50,23 +46,15 @@  -- | One base element of a pattern ---data PatternComponent = CaptureOne+data PatternComponent = Capture                       | CaptureMany                       | Literal String-                      deriving (Eq)--instance Show PatternComponent where-    show CaptureOne = "*"-    show CaptureMany = "**"-    show (Literal s) = s+                      deriving (Eq, Show)  -- | Type that allows matching on identifiers -- newtype Pattern = Pattern {unPattern :: [PatternComponent]}-                deriving (Eq)--instance Show Pattern where-    show = intercalate "/" . map show . unPattern+                deriving (Eq, Show)  instance IsString Pattern where     fromString = parsePattern@@ -74,16 +62,20 @@ -- | Parse a pattern from a string -- parsePattern :: String -> Pattern-parsePattern = Pattern . map toPattern . unIdentifier . parseIdentifier+parsePattern = Pattern . parse' -- undefined -- Pattern . map toPattern . unIdentifier . parseIdentifier   where-    toPattern x | x == "*"  = CaptureOne-                | x == "**" = CaptureMany-                | otherwise = Literal x+    parse' str =+        let (chunk, rest) = break (`elem` "\\*") str+        in case rest of+            ('\\' : x   : xs) -> Literal (chunk ++ [x]) : parse' xs+            ('*'  : '*' : xs) -> Literal chunk : CaptureMany : parse' xs+            ('*'  : xs)       -> Literal chunk : Capture : parse' xs+            xs                -> Literal chunk : Literal xs : []  -- | Match an identifier against a pattern, generating a list of captures -- match :: Pattern -> Identifier -> Maybe [Identifier]-match (Pattern p) (Identifier i) = fmap (map Identifier) $ match' p i+match p (Identifier i) = fmap (map Identifier) $ match' (unPattern p) i  -- | Check if an identifier matches a pattern --@@ -95,31 +87,30 @@ matches :: Pattern -> [Identifier] -> [Identifier] matches p = filter (doesMatch p) --- | Split a list at every possible point, generate a list of (init, tail) cases+-- | 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 ls = reverse $ splits' [] ls-  where-    splits' lx ly = (lx, ly) : case ly of-        []       -> []-        (y : ys) -> splits' (lx ++ [y]) ys+splits = inits &&& tails >>> uncurry zip >>> reverse  -- | Internal verion of 'match' ---match' :: [PatternComponent] -> [String] -> Maybe [[String]]+match' :: [PatternComponent] -> String -> Maybe [String] match' [] [] = Just []  -- An empty match-match' [] _ = Nothing   -- No match-match' _ [] = Nothing   -- No match-match' (m : ms) (s : ss) = case m of-    -- Take one string and one literal, fail on mismatch-    Literal l -> if s == l then match' ms ss else Nothing-    -- Take one string and one capture-    CaptureOne -> fmap ([s] :) $ match' ms ss-    -- Take one string, and one or many captures-    CaptureMany ->-        let take' (i, t) = fmap (i :) $ match' ms t-        in msum $ map take' $ splits (s : ss)-+match' [] _  = Nothing  -- No match+-- match' _  [] = Nothing   -- No match+match' (Literal l : ms) str+    -- Match the literal against the string+    | l `isPrefixOf` str = match' ms $ drop (length l) str+    | otherwise          = Nothing+match' (Capture : ms) str =+    -- Match until the next /+    let (chunk, rest) = break (== '/') str+    in msum $ [ fmap (i :) (match' ms (t ++ rest)) | (i, t) <- splits chunk ]+match' (CaptureMany : ms) str =+    -- Match everything+    msum $ [ fmap (i :) (match' ms t) | (i, t) <- splits str ]+     -- | Create an identifier from a pattern by filling in the captures with a given -- string --@@ -152,9 +143,9 @@ fromCaptures :: Pattern -> [Identifier] -> Identifier fromCaptures (Pattern []) _ = mempty fromCaptures (Pattern (m : ms)) [] = case m of-    Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) []+    Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) []     _         -> error $  "Hakyll.Core.Identifier.Pattern.fromCaptures: "                        ++ "identifier list exhausted" fromCaptures (Pattern (m : ms)) ids@(i : is) = case m of-    Literal l -> Identifier [l] `mappend` fromCaptures (Pattern ms) ids+    Literal l -> Identifier l `mappend` fromCaptures (Pattern ms) ids     _         -> i `mappend` fromCaptures (Pattern ms) is

@@ -1,6 +1,6 @@ -- | This is the module which binds it all together ---{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-} module Hakyll.Core.Run     ( run     ) where@@ -10,7 +10,7 @@ import Control.Monad.Trans (liftIO) import Control.Applicative (Applicative, (<$>)) import Control.Monad.Reader (ReaderT, runReaderT, ask)-import Control.Monad.State.Strict (StateT, evalStateT, get, modify)+import Control.Monad.State.Strict (StateT, runStateT, get, modify) import Control.Arrow ((&&&)) import qualified Data.Map as M import Data.Monoid (mempty, mappend)@@ -50,9 +50,13 @@          -- Extract the reader/state         reader = unRuntime $ addNewCompilers [] compilers-        state' = runReaderT reader $ env logger ruleSet provider store+        stateT = runReaderT reader $ env logger ruleSet provider store -    evalStateT state' state+    -- Run the program and fetch the resulting state+    ((), state') <- runStateT stateT state++    -- We want to save the final dependency graph for the next run+    storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'      -- Flush and return     flushLogger logger

@@ -1,5 +1,6 @@ -- | A store for stroing and retreiving items --+{-# LANGUAGE ExistentialQuantification #-} module Hakyll.Core.Store     ( Store     , makeStore@@ -14,20 +15,22 @@ import qualified Data.Map as M  import Data.Binary (Binary, encodeFile, decodeFile)-import Data.Typeable (Typeable)+import Data.Typeable (Typeable, cast) -import Hakyll.Core.CompiledItem-import Hakyll.Core.Writable import Hakyll.Core.Identifier import Hakyll.Core.Util.File +-- | Items we can store+--+data Storable = forall a. (Binary a, Typeable a) => Storable a+ -- | Data structure used for the store -- data Store = Store     { -- | All items are stored on the filesystem       storeDirectory :: FilePath     , -- | And some items are also kept in-memory-      storeMap :: MVar (Map FilePath CompiledItem)+      storeMap :: MVar (Map FilePath Storable)     }  -- | Initialize the store@@ -42,20 +45,19 @@  -- | Auxiliary: add an item to the map ---addToMap :: (Binary a, Typeable a, Writable a)-         => Store -> FilePath -> a -> IO ()+addToMap :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO () addToMap store path value =-    modifyMVar_ (storeMap store) $ return . M.insert path (compiledItem value)+    modifyMVar_ (storeMap store) $ return . M.insert path (Storable value)  -- | Create a path -- makePath :: Store -> String -> Identifier -> FilePath makePath store name identifier =-    storeDirectory store </> name </> toFilePath identifier </> ".hakyllstore"+    storeDirectory store </> name </> toFilePath identifier </> "hakyllstore"  -- | Store an item ---storeSet :: (Binary a, Typeable a, Writable a)+storeSet :: (Binary a, Typeable a)          => Store -> String -> Identifier -> a -> IO () storeSet store name identifier value = do     makeDirectories path@@ -66,14 +68,14 @@  -- | Load an item ---storeGet :: (Binary a, Typeable a, Writable a)+storeGet :: (Binary a, Typeable a)          => Store -> String -> Identifier -> IO (Maybe a) storeGet store name identifier = do     -- First check the in-memory map     map' <- readMVar $ storeMap store     case M.lookup path map' of         -- Found in the in-memory map-        Just c -> return $ Just $ unCompiledItem c+        Just (Storable s) -> return $ cast s         -- Not found in the map, try the filesystem         Nothing -> do             exists <- doesFileExist path

@@ -11,6 +11,8 @@     , copyField     , renderDateField     , renderDateFieldWith+    , copyBodyToField+    , copyBodyFromField     ) where  import Prelude hiding (id)@@ -138,3 +140,17 @@                           "%Y-%m-%d"                           dateString :: Maybe UTCTime         return $ formatTime locale format time++-- | 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

@@ -8,6 +8,7 @@ import Control.Monad.Trans (liftIO) import Control.Applicative ((<$>)) import Codec.Binary.UTF8.String+import Network.HTTP.Base (urlDecode) import System.FilePath ((</>)) import System.Directory (doesFileExist) @@ -39,7 +40,7 @@     let filePath = replaceAll "\\?$"    (const "")  -- Remove trailing ?                  $ replaceAll "#[^#]*$" (const "")  -- Remove #section                  $ replaceAll "^/"      (const "")  -- Remove leading /-                 $ decode $ SB.unpack uri+                 $ urlDecode $ decode $ SB.unpack uri      -- Try to find the requested file     r <- liftIO $ findFile $ map (directory </>) $