Browse Source

Move things around because "content" is a terrible word, trying to make tests pass again

contexts-draft2
Logan McGrath 10 months ago
parent
commit
89a9f5e385
  1. 2
      app/author/Main.hs
  2. 2
      app/site/Main.hs
  3. 30
      green.cabal
  4. 2
      site/index.html
  5. 26
      src/Green.hs
  6. 37
      src/Green/Content.hs
  7. 36
      src/Green/Site.hs
  8. 36
      src/Green/Site/Blog.hs
  9. 2
      src/Green/Site/BrokenLinks.hs
  10. 2
      src/Green/Site/Code.hs
  11. 2
      src/Green/Site/Css.hs
  12. 2
      src/Green/Site/Download.hs
  13. 2
      src/Green/Site/Feed.hs
  14. 8
      src/Green/Site/HomePage.hs
  15. 2
      src/Green/Site/Image.hs
  16. 2
      src/Green/Site/Js.hs
  17. 2
      src/Green/Site/Page.hs
  18. 2
      src/Green/Site/Robots.hs
  19. 4
      src/Green/Site/Sitemap.hs
  20. 2
      src/Green/Site/Templates.hs
  21. 2
      src/Green/Template/Custom/Context.hs
  22. 8
      src/Green/Template/Source/Lexer.hs
  23. 6
      test/Green/RouteSpec.hs
  24. 20
      test/Green/Site/BlogSpec.hs
  25. 8
      test/Green/TestSupport/Compiler.hs
  26. 5
      test/Green/TestSupport/Config.hs

2
app/author/Main.hs

@ -1,4 +1,4 @@
import Green
main :: IO ()
main = author
main = authorMain

2
app/site/Main.hs

@ -1,4 +1,4 @@
import Green
main :: IO ()
main = site
main = siteMain

30
green.cabal

@ -26,24 +26,24 @@ library
Green.Common
Green.Compiler
Green.Config
Green.Content
Green.Content.Blog
Green.Content.BrokenLinks
Green.Content.Code
Green.Content.Css
Green.Content.Download
Green.Content.Feed
Green.Content.HomePage
Green.Content.Image
Green.Content.Js
Green.Content.Page
Green.Content.Robot
Green.Content.Sitemap
Green.Content.Template
Green.Lens
Green.Lens.Hakyll
Green.Lens.TH
Green.Route
Green.Site
Green.Site.Blog
Green.Site.BrokenLinks
Green.Site.Code
Green.Site.Css
Green.Site.Download
Green.Site.Feed
Green.Site.HomePage
Green.Site.Image
Green.Site.Js
Green.Site.Page
Green.Site.Robots
Green.Site.Sitemap
Green.Site.Templates
Green.Template
Green.Template.Ast
Green.Template.Compiler
@ -249,7 +249,7 @@ test-suite test
main-is: Spec.hs
other-modules:
Green.RouteSpec
Green.Rule.BlogSpec
Green.Site.BlogSpec
Green.Template.AstStructure
Green.Template.Source.LexerSpec
Green.Template.Source.ParserSpec

2
site/index.html

@ -101,7 +101,7 @@ layout: page
<h3>Some Writing</h3>
<p>Here's a sampling of things I've blogged about. A complete selection may be found on their <a href="{{route 'blog.html'}}">dedicated page</a>.</p>
<ul>
{{#for previousPosts}}
{{#for recentPosts}}
<li>
<a href="{{url}}">{{title}}</a> - {{date | dateAs shortDate}}
</li>

26
src/Green.hs

@ -5,21 +5,18 @@ import Data.Time
import Green.Command
import Green.Common
import Green.Config
import Green.Content
import Green.Site
import qualified Hakyll as H
import Options.Applicative
import System.Environment
site :: IO ()
site = do
siteMain :: IO ()
siteMain = do
siteConfig <- loadSiteConfig
putStrLn $ replicate 80 '-'
print siteConfig
putStrLn $ replicate 80 '-'
H.hakyllWith (siteConfig ^. siteHakyllConfiguration) (content siteConfig)
H.hakyllWith (siteConfig ^. siteHakyllConfiguration) (site siteConfig)
author :: IO ()
author = do
authorMain :: IO ()
authorMain = do
progName <- getProgName
siteConfig <- loadSiteConfig
processAuthorCommand siteConfig =<< customExecParser prefs' (authorCommands progName)
@ -31,5 +28,12 @@ loadSiteConfig = do
env <- getEnvironment
time <- utcToZonedTime <$> getCurrentTimeZone <*> getCurrentTime
configIniText <- TIO.readFile "config.ini"
let result = parseConfigIni env defaultTimeLocale time configIniText
either fail return result
siteConfig <-
either fail return $
parseConfigIni env defaultTimeLocale time configIniText
putStrLn $ replicate 80 '-'
print siteConfig
putStrLn $ replicate 80 '-'
return siteConfig

37
src/Green/Content.hs

@ -1,37 +0,0 @@
module Green.Content (content) where
import Green.Common
import Green.Config
import Green.Content.Blog
import Green.Content.BrokenLinks
import Green.Content.Code
import Green.Content.Css
import Green.Content.Download
import Green.Content.Feed
import Green.Content.HomePage
import Green.Content.Image
import Green.Content.Js
import Green.Content.Page
import Green.Content.Robot
import Green.Content.Sitemap
import Green.Content.Template
import Green.Template.Custom.Context
content :: SiteConfig -> Rules ()
content config = do
let context = customContext config
brokenLinks
images
js
scss config
downloads
codeDep <- code
templateDep <- templates
rulesExtraDependencies [codeDep, templateDep] do
blog context
feed
homePage context
pages context
robotsTxt context
sitemap context
brokenLinks

36
src/Green/Site.hs

@ -0,0 +1,36 @@
module Green.Site where
import Green.Common
import Green.Config
import Green.Site.Blog
import Green.Site.BrokenLinks
import Green.Site.Code
import Green.Site.Css
import Green.Site.Download
import Green.Site.Feed
import Green.Site.HomePage
import Green.Site.Image
import Green.Site.Js
import Green.Site.Page
import Green.Site.Robots
import Green.Site.Sitemap
import Green.Site.Templates
import Green.Template.Custom.Context
site :: SiteConfig -> Rules ()
site config = do
let context = customContext config
brokenLinks
images
js
scss config
downloads
_codeDep <- code
_templateDep <- templates
blog context
feed
homePage context
pages context
robotsTxt context
sitemap context
brokenLinks

36
src/Green/Content/Blog.hs → src/Green/Site/Blog.hs

@ -1,10 +1,4 @@
module Green.Content.Blog
( blog,
loadPublishedPosts,
publishedPostsSnapshot,
recentPostsContext,
)
where
module Green.Site.Blog where
import Green.Common
import Green.Compiler (loadExistingSnapshots)
@ -80,11 +74,7 @@ draftsIndex context = do
posts :: Context String -> Rules ()
posts context = do
match "_posts/**" do
route $
subPrefixRoute
`composeRoutes` dateRoute
`composeRoutes` setExtension "html"
`composeRoutes` indexRoute
route postsRoute
compile $
getResourceBody
>>= contentCompiler postsContext
@ -93,16 +83,18 @@ posts context = do
>>= relativizeUrls
where
postsContext = postContext <> context
subPrefixRoute = subRoute "^_posts/" "blog/"
postsRoute :: Routes
postsRoute =
subRoute "^_posts/" "blog/"
`composeRoutes` dateRoute
`composeRoutes` setExtension "html"
`composeRoutes` indexRoute
drafts :: Context String -> Rules ()
drafts context = do
match "_drafts/**" do
route $
subPrefixRoute
`composeRoutes` dateRoute
`composeRoutes` setExtension "html"
`composeRoutes` indexRoute
route draftsRoute
compile $
getResourceBody
>>= contentCompiler draftsContext
@ -111,7 +103,13 @@ drafts context = do
>>= relativizeUrls
where
draftsContext = postContext <> context
subPrefixRoute = subRoute "_drafts/" "drafts/"
draftsRoute :: Routes
draftsRoute =
subRoute "_drafts/" "drafts/"
`composeRoutes` dateRoute
`composeRoutes` setExtension "html"
`composeRoutes` indexRoute
categoriesPages :: Tags -> Context String -> Rules ()
categoriesPages categories context =

2
src/Green/Content/BrokenLinks.hs → src/Green/Site/BrokenLinks.hs

@ -1,4 +1,4 @@
module Green.Content.BrokenLinks (brokenLinks) where
module Green.Site.BrokenLinks where
import Green.Common
import Hakyll (preprocess)

2
src/Green/Content/Code.hs → src/Green/Site/Code.hs

@ -1,4 +1,4 @@
module Green.Content.Code (code) where
module Green.Site.Code where
import Green.Common

2
src/Green/Content/Css.hs → src/Green/Site/Css.hs

@ -1,4 +1,4 @@
module Green.Content.Css (scss) where
module Green.Site.Css where
import Green.Common
import Green.Config

2
src/Green/Content/Download.hs → src/Green/Site/Download.hs

@ -1,4 +1,4 @@
module Green.Content.Download (downloads) where
module Green.Site.Download where
import Green.Common

2
src/Green/Content/Feed.hs → src/Green/Site/Feed.hs

@ -1,4 +1,4 @@
module Green.Content.Feed (feed) where
module Green.Site.Feed where
import Green.Common

8
src/Green/Content/HomePage.hs → src/Green/Site/HomePage.hs

@ -1,7 +1,7 @@
module Green.Content.HomePage (homePage) where
module Green.Site.HomePage where
import Green.Common
import Green.Content.Blog
import Green.Site.Blog
import Green.Template.Custom
import Hakyll (recentFirst)
@ -10,9 +10,9 @@ homePage siteContext =
match "index.html" do
route idRoute
compile do
posts <- fmap (take 5) $ recentFirst =<< loadPublishedPosts
recentPosts <- fmap (take 5) $ recentFirst =<< loadPublishedPosts
let context =
constField "previousPosts" (itemListValue siteContext posts)
constField "recentPosts" (itemListValue siteContext recentPosts)
<> teaserField "teaser" publishedPostsSnapshot
<> siteContext
getResourceBody

2
src/Green/Content/Image.hs → src/Green/Site/Image.hs

@ -1,4 +1,4 @@
module Green.Content.Image (images) where
module Green.Site.Image where
import Green.Common

2
src/Green/Content/Js.hs → src/Green/Site/Js.hs

@ -1,4 +1,4 @@
module Green.Content.Js (js) where
module Green.Site.Js where
import qualified Data.ByteString.Lazy.Char8 as C
import Hakyll

2
src/Green/Content/Page.hs → src/Green/Site/Page.hs

@ -1,4 +1,4 @@
module Green.Content.Page (pages) where
module Green.Site.Page where
import Green.Common
import Green.Route

2
src/Green/Content/Robot.hs → src/Green/Site/Robots.hs

@ -1,4 +1,4 @@
module Green.Content.Robot (robotsTxt) where
module Green.Site.Robots where
import Green.Common
import Green.Template

4
src/Green/Content/Sitemap.hs → src/Green/Site/Sitemap.hs

@ -1,8 +1,8 @@
module Green.Content.Sitemap (sitemap) where
module Green.Site.Sitemap where
import Green.Common
import Green.Compiler (loadExistingSnapshots)
import Green.Content.Blog (loadPublishedPosts)
import Green.Site.Blog (loadPublishedPosts)
import Green.Template
import Hakyll (recentFirst)

2
src/Green/Content/Template.hs → src/Green/Site/Templates.hs

@ -1,4 +1,4 @@
module Green.Content.Template (templates) where
module Green.Site.Templates where
import Green.Common
import Green.Template

2
src/Green/Template/Custom/Context.hs

@ -2,7 +2,7 @@ module Green.Template.Custom.Context where
import Green.Common
import Green.Config
import Green.Content.Blog (loadPublishedPosts)
import Green.Site.Blog (loadPublishedPosts)
import Green.Template
import Green.Template.Custom.DateField
import Green.Template.Custom.GitField

8
src/Green/Template/Source/Lexer.hs

@ -117,15 +117,15 @@ text = mconcat <$> manyTill p (lookAhead $ try end)
labeled "Just '}'" $ closeBrace <* notFollowedBy (try closeBrace),
labeled "Just '-'" $ string "-" <* notFollowedBy braces,
labeled "Just '\\'" $ string "\\" <* notFollowedBy (braces <|> try (string "-")),
labeled "EscapedBlock" $ char '\\' *> braces,
labeled "SpaceString" $ many1 space <* notFollowedBy trimmingClose
labeled "EscapedText" $ char '\\' *> tryOne [braces, string "\\", string "-"],
labeled "SpaceString" $ many1 space <* notFollowedBy trimmingOpen
]
braces = tryOne [open, close, trimmingOpen, trimmingClose]
braces = tryOne [open, close, trimmingOpen, trimmingOpen]
end =
labeled "text terminator" . tryOne $
[ open,
close,
spaces *> trimmingClose,
spaces *> trimmingOpen,
"" <$ eof
]

6
test/Green/RouteSpec.hs

@ -12,9 +12,3 @@ spec = do
("contact.html", Just "contact/index.html"),
("contact/index.html", Just "contact/index.html")
]
describe "subPrefixRoute" do
runRouteExamples (subPrefixRoute "pages/" "potatoes/") $
[ ("pages/contact.md", Just "potatoes/contact.md"),
("pages/archives.html", Just "potatoes/archives.html"),
("404.md", Just "404.md")
]

20
test/Green/Rule/BlogSpec.hs → test/Green/Site/BlogSpec.hs

@ -1,6 +1,6 @@
module Green.Rule.BlogSpec where
module Green.Site.BlogSpec where
import Green.Rule.Blog
import Green.Site.Blog
import Green.TestSupport
spec :: Spec
@ -13,16 +13,16 @@ spec = do
("not-this-one.md", Just "not-this-one.md"),
("underwater-basketry/2012-11-07-this-one.md", Just "underwater-basketry/2012/11/07/this-one.md")
]
describe "postRoute" do
runRouteExamples postRoute $
describe "postsRoute" do
runRouteExamples postsRoute $
[ ("_posts/2012-11-07-this-one.md", Just "blog/2012/11/07/this-one/index.html"),
("_posts/2012-11-16-that-one.md", Just "blog/2012/11/16/that-one/index.html"),
("_posts/not-this-one.md", Nothing),
("_posts/not-this-one.md", Just "blog/not-this-one/index.html"),
("_posts/underwater-basketry/2012-11-07-this-one.md", Just "blog/underwater-basketry/2012/11/07/this-one/index.html")
]
describe "draftRoute" do
runRouteExamples draftRoute $
[ ("_drafts/this-one.md", Just "blog/drafts/this-one/index.html"),
("_drafts/that-one.md", Just "blog/drafts/that-one/index.html"),
("_drafts/underwater-basketry/this-one.md", Just "blog/drafts/underwater-basketry/this-one/index.html")
describe "draftsRoute" do
runRouteExamples draftsRoute $
[ ("_drafts/this-one.md", Just "drafts/this-one/index.html"),
("_drafts/that-one.md", Just "drafts/that-one/index.html"),
("_drafts/underwater-basketry/this-one.md", Just "drafts/underwater-basketry/this-one/index.html")
]

8
test/Green/TestSupport/Compiler.hs

@ -1,10 +1,10 @@
module Green.TestSupport.Compiler where
import Data.Set as S
import Green.TestSupport.TestEnv
import Hakyll as H
import Hakyll.Core.Compiler.Internal
import qualified Hakyll.Core.Logger as Logger
import Green.TestSupport.TestEnv
import Test.Hspec
type RunCompiler a = Compiler a -> Identifier -> IO (CompilerResult a)
@ -33,8 +33,8 @@ shouldProduce (CompilerDone item _) expected =
itemBody item `shouldBe` expected
shouldProduce (CompilerSnapshot snapshot _) _ =
expectationFailure $ "Compiler did not complete, received snapshot " ++ snapshot
shouldProduce (CompilerRequire (identifier, snapshot) _) _ =
expectationFailure $ "Compiler did not complete, produced dependency on " ++ show identifier ++ " snapshot " ++ snapshot
shouldProduce (CompilerRequire dependencies _) _ =
expectationFailure $ "Compiler did not complete, produced dependencies on " ++ show dependencies
shouldProduce (CompilerError errors) _ = expectationFailure message
where
message = case errors of
@ -43,4 +43,4 @@ shouldProduce (CompilerError errors) _ = expectationFailure message
CompilationNoResult exceptions -> "Compiler produced no result with exceptions: " ++ show exceptions
compileBody :: (Item String -> Compiler (Item String)) -> Compiler (Item String)
compileBody compiler = getUnderlying >>= loadBody >>= compiler
compileBody compiler = getResourceBody >>= compiler

5
test/Green/TestSupport/Config.hs

@ -3,7 +3,7 @@ module Green.TestSupport.Config where
import Data.Time
import Green.Common
import Green.Config
import Hakyll (Configuration (..))
import Hakyll (Configuration (..), defaultConfiguration)
defaultTestTimeString :: String
defaultTestTimeString = "2013-06-16T21:12:00-07:00"
@ -44,7 +44,8 @@ defaultSiteConfigWith hakyllConfig =
SiteDisplayFormat
{ _displayDateLongFormat = "%B %e, %Y %l:%M %P %EZ",
_displayDateShortFormat = "%B %e, %Y",
_displayTimeFormat = "%l:%M %p %EZ"
_displayTimeFormat = "%l:%M %p %EZ",
_displayImageWidths = [320, 768, 1024, 1920, 3840]
},
_siteDebug = defaultSiteDebug
}

Loading…
Cancel
Save