Browse Source

parser wip

image-sizing
Logan McGrath 1 year ago
parent
commit
84ea784a21
  1. 5
      Makefile
  2. 5
      commands.sh
  3. 8
      logans-blog.cabal
  4. 1
      package.yaml
  5. 32
      src/Site/Metadata.hs
  6. 21
      test/Site/MetadataSpec.hs
  7. 19
      test/Site/UtilSpec.hs

5
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

5
commands.sh

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

8
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

1
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:

32
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 ->

21
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

19
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"

Loading…
Cancel
Save