parser wip

Makefile

@@ -22,5 +22,8 @@ publish:
 setup:
 	set -e; source "commands.sh"; setup
 
+test:
+	set -e; source "commands.sh"; test
+
 .ONESHELL:
-.PHONY: publish watch rebuild build clean
+.PHONY: publish watch rebuild build clean test

commands.sh

@@ -81,3 +81,8 @@ test_sync () {
 
   echo "INFO: Local branch $branch is up to date with remote"
 }
+
+test () {
+  stack test
+}
+

logans-blog.cabal

@@ -1,8 +1,10 @@
 cabal-version: 1.12
 
--- This file has been generated from package.yaml by hpack version 0.34.3.
+-- This file has been generated from package.yaml by hpack version 0.33.0.
 --
 -- see: https://github.com/sol/hpack
+--
+-- hash: 191703dc414ab1bd287bf779382554643ec3f1e3cbb5ac267f2ac16e38626088
 
 name:           logans-blog
 version:        0.1.0.0
@@ -69,6 +71,7 @@ library
     , text ==1.2.*
     , time ==1.9.*
     , unordered-containers ==0.2.*
+    , utf8-string ==1.0.*
     , vector ==0.12.*
   default-language: Haskell2010
 
@@ -100,6 +103,7 @@ executable logans-blog-exe
     , text ==1.2.*
     , time ==1.9.*
     , unordered-containers ==0.2.*
+    , utf8-string ==1.0.*
     , vector ==0.12.*
   default-language: Haskell2010
 
@@ -107,6 +111,7 @@ test-suite logans-blog-test
   type: exitcode-stdio-1.0
   main-is: Spec.hs
   other-modules:
+      Site.MetadataSpec
       Site.UtilSpec
       Paths_logans_blog
   hs-source-dirs:
@@ -133,5 +138,6 @@ test-suite logans-blog-test
     , text ==1.2.*
     , time ==1.9.*
     , unordered-containers ==0.2.*
+    , utf8-string ==1.0.*
     , vector ==0.12.*
   default-language: Haskell2010

package.yaml

@@ -30,6 +30,7 @@ dependencies:
   - text == 1.2.*
   - time == 1.9.*
   - unordered-containers == 0.2.*
+  - utf8-string == 1.0.*
   - vector == 0.12.*
 
 library:

src/Site/Metadata.hs

@@ -30,16 +30,16 @@ data PostMetadata = PostMetadata
   }
   deriving stock (Generic, Show)
 
-instance ToJSON PostMetadata
-
-instance FromJSON PostMetadata where
-  parseJSON = withObject "PostMetadata" parsePostMetadata
+data PostMetadataConfig = PostMetadataConfig
+  { defaultContentTemplates :: [String],
+    defaultTemplates :: [String]
+  }
 
-parsePostMetadata :: Object -> Parser PostMetadata
-parsePostMetadata pm =
+parsePostMetadata :: PostMetadataConfig -> Object -> Parser PostMetadata
+parsePostMetadata config pm =
   PostMetadata
-    <$> withOneOrMoreStrings "content-templates" "bare-content" pm
-    <*> withOneOrMoreStrings "templates" "skeleton" pm
+    <$> defaultContentTemplates config `firstIfEmpty` fromStringOrList "content-templates" pm
+    <*> defaultTemplates config `firstIfEmpty` fromStringOrList "templates" pm
     <*> (withMaybeField "title" toString pm <&> fromMaybe "Untitled")
     <*> withMaybeField "author" toString pm
     <*> withField "created" toDate pm
@@ -48,6 +48,22 @@ parsePostMetadata pm =
     <*> withField "published" (`withBool` return) pm
     <*> withZeroOrMoreStrings "tags" pm
 
+firstIfEmpty :: (Functor m) => [a] -> m [a] -> m [a]
+firstIfEmpty d mxs = go <$> mxs
+  where
+    go [] = d
+    go xs = xs
+
+fromStringOrList :: String -> Object -> Parser [String]
+fromStringOrList k o =
+  splitAndStrip "," . T.unpack <$> (o .: k' <?> Key k' :: Parser T.Text)
+    <|> fmap T.unpack <$> (o .: k' <?> Key k' :: Parser [T.Text])
+  where
+    k' = T.pack k
+
+splitAndStrip :: String -> String -> [String]
+splitAndStrip d = fmap S.strip . S.split d
+
 withZeroOrMoreStrings ::
   -- | the field to parse
   String ->

test/Site/MetadataSpec.hs

@@ -0,0 +1,21 @@
+module Site.MetadataSpec (spec) where
+
+import Data.Aeson
+import qualified Data.ByteString.Lazy.UTF8 as B
+import Site.Metadata
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "PostMetadata" do
+    it "deserializes from YAML" do
+      let yaml =
+            "content-templates: post \n\
+            \templates: default, skeleton \n\
+            \title: \"App-Config-App in Action\" \n\
+            \author: \"Logan McGrath\" \n\
+            \date: 2012-11-20T07:00:00 CST \n\
+            \comments: false \n\
+            \published: true \n\
+            \tags: AngularJS, Perforce, SCM, Sinatra, Configuration Management"
+      return () -- TODO

test/Site/UtilSpec.hs

@@ -1,9 +1,22 @@
 module Site.UtilSpec (spec) where
 
+import Site.Util
 import Test.Hspec
 
 spec :: Spec
 spec = do
-  describe "Hello" do
-    it "prints World" do
-      putStrLn "Hello World"
+  describe "stripSuffix" do
+    let suffix = "index.html"
+    context "the suffix exists" do
+      let input = "this/path/to/index.html"
+      it "strips the suffix" do
+        stripSuffix suffix input `shouldBe` "this/path/to/"
+    context "the suffix does not exist" do
+      let input = "this/path/to/something-else.html"
+      it "returns the original string" do
+        stripSuffix suffix input `shouldBe` input
+
+  describe "loadAbsRoot" do
+    it "creats a URL prefix with the CNAME file contents" do
+      root <- loadAbsRoot
+      root `shouldBe` "https://www.thisfieldwas.green"