updated achille version

src/Common.hs

@@ -4,7 +4,7 @@ module Common
     , module Data.String
     , module System.FilePath
     , module Achille
-    , module Achille.Recipe.Pandoc
+    , module Achille.Task.Pandoc
     , module Data.Text
     , module Control.Monad
     , module Data.Maybe
@@ -15,7 +15,7 @@ module Common
     ) where
 
 import Achille
-import Achille.Recipe.Pandoc
+import Achille.Task.Pandoc
 
 import Data.Aeson.Types (FromJSON)
 import GHC.Generics     (Generic)

src/Main.hs

@@ -27,7 +27,7 @@ data Cmd
 
 
 cli :: Parser Cmd
-cli = subparser $
+cli = hsubparser $
       command "build"  (info (Build <$> switch (long "draft" <> short 'D' <> help "Display drafts"))
                              (progDesc "Build the site once" ))
    <> command "deploy" (info (pure Deploy) (progDesc "Server go brrr"      ))
@@ -53,11 +53,11 @@ build showDrafts = do
     match_ "assets/*" copyFile
 
     -- quid page
-    match_ "./quid.rst" $
+    match_ "./quid.rst" \src ->
-        compilePandoc 
+        compilePandoc src
         <&> toHtmlRaw
         <&> outerWith def {Config.title = "quid"}
-        >>= saveFileAs (-<.> "html")
+        >>= write (src -<.> "html")
 
     Visual.build
     Projects.build

src/Posts.hs

@@ -36,14 +36,14 @@ data Post = Post
 instance IsTimestamped Post where timestamp = postDate
 
 
-buildPost :: Recipe IO FilePath Post
+buildPost :: FilePath -> Task IO Post
-buildPost = do
+buildPost src = do
-    src <- copyFile
+    copyFile src
-    (PostMeta title draft desc, pandoc) <- readPandocMetadataWith ropts
+    (PostMeta title draft desc, pandoc) <- readPandocMetadataWith ropts src
     content <- renderPandocWith wopts pandoc
 
     pure (renderPost title src content)
-        >>= saveFileAs (-<.> "html")
+        >>= write (src -<.> "html")
         <&> Post title (timestamp src) (fromMaybe False draft) Nothing content
 
 toDate :: UTCTime -> String
@@ -55,10 +55,10 @@ build showDrafts = do
              <&> filter (\p -> not (postDraft p) || showDrafts)
              <&> recentFirst
 
-    watch posts $ match_ "index.rst" do
+    watch posts $ match_ "index.rst" \src -> do
-        compilePandoc
+        compilePandoc src
             <&> renderIndex posts
-            >>= saveFileAs (-<.> "html")
+            >>= write (src -<.> "html")
 
         now <- liftIO getCurrentTime
         let (Just feed) = textFeed (AtomFeed $ postsToFeed now posts)

src/Projects.hs

@@ -21,36 +21,35 @@ build :: Task IO ()
 build = do
     projects <- matchDir "projects/*/" buildProject
 
-    watch projects $ match_ "./projects.rst" do
+    watch projects $ match_ "./projects.rst" \src -> do
-        intro <- compilePandocWith def wopts
+        intro <- compilePandocWith def wopts src
         write "projects.html" (renderIndex intro projects)
 
 
-buildProject :: Recipe IO a (Project, FilePath)
+buildProject :: FilePath -> Task IO (Project, FilePath)
-buildProject = do
+buildProject src = do
     match "*" copyFile
 
     name     <- takeBaseName <$> getCurrentDir
     children <- buildChildren name
 
-    watch children $ matchFile "index.*" do
+    watch children $ matchFile "index.*" \src -> do
-        (meta, doc) <- readPandocMetadataWith ropts
+        (meta, doc) <- readPandocMetadataWith ropts src
 
         renderPandocWith wopts doc
             <&> renderProject meta children
-            >>= saveFileAs (-<.> "html")
+            >>= write (src -<.> "html")
 
         (meta,) <$> getCurrentDir
     where
-        buildChildren :: String -> Recipe IO a [(Text, FilePath)]
+        buildChildren :: String -> Task IO [(Text, FilePath)]
-        buildChildren name = match "pages/*" do
+        buildChildren name = match "pages/*" \filepath -> do
-            filepath <- getInput
             let (key, file) = getKey $ takeFileName filepath
-            (TitledPage title _, doc) <- readPandocMetadataWith ropts
+            (TitledPage title _, doc) <- readPandocMetadataWith ropts filepath
             renderPandocWith wopts doc
                 <&> toHtmlRaw
                 <&> outerWith (def {Config.title = title})
-                >>= saveFileAs (const $ file -<.> "html")
+                >>= write (filepath -<.> "html")
                 <&> (title,)
 
 

src/Readings.hs

@@ -14,12 +14,12 @@ data Book = Book
     } deriving (Generic, Show, FromJSON)
 
 
-build :: Recipe IO () FilePath
+build :: Task IO FilePath
-build = matchFile "readings.yaml" $
+build = matchFile "readings.yaml" \p ->
-    readBS
+    readBS p
         >>= (liftIO . Yaml.decodeThrow)
         <&> renderReadings
-        >>= saveFileAs (-<.> "html")
+        >>= write (p -<.> "html")
 
 
 renderReadings :: [Book] -> Html ()

src/Visual.hs

@@ -7,14 +7,16 @@ import Lucid
 
 build :: Task IO ()
 build = do
-    pictures <- match "visual/*" do
+    pictures <- match "visual/*" \src -> do
-      copyFile
+      copyFile src
-      runCommandWith (-<.> "thumb.png")
+      callCommandWith
-                     (\a b -> "convert -resize 740x " <> a <> " " <> b)
+         (\a b -> "convert -resize 740x " <> a <> " " <> b)
-          <&> timestamped
+         (-<.> "thumb.png")
+         src
+      <&> timestamped
 
-    watch pictures $ match_ "./visual.rst" do
+    watch pictures $ match_ "./visual.rst" \src -> do
-        intro <- compilePandoc
+        intro <- compilePandoc src
         write "visual.html" $ renderVisual intro (recentFirst pictures)
 
 renderVisual :: Text -> [Timestamped FilePath] -> Html ()