geek 1.0.0.9 → 1.1
raw patch · 6 files changed
+18/−251 lines, 6 filesdep −hspecdep −splitdep −uuid
Dependencies removed: hspec, split, uuid
Files
- geek.cabal +1/−7
- src/Web/Geek/Config.hs +1/−8
- src/Web/Geek/ImportFromBamboo.hs +0/−120
- src/Web/Geek/Post.hs +16/−60
- src/Web/Geek/Runtime.hs +0/−42
- src/Web/Geek/Spec.hs +0/−14
geek.cabal view
@@ -1,5 +1,5 @@ Name: geek-Version: 1.0.0.9+Version: 1.1 Build-type: Simple Synopsis: Geek blog engine Description: A dynamic blog engine, customizable with standard web technology, i.e. HTML, CSS and Javascript (JSON)@@ -14,9 +14,7 @@ homepage: http://github.com/nfjinjing/geek data-files: Nemesis- , src/Web/Geek/ImportFromBamboo.hs - Library ghc-options: -W build-depends: base >= 4 && < 99@@ -35,19 +33,16 @@ , fsnotify , hack2 , hack2-contrib- , hspec , miku , mtl , old-locale , process , random , safe- , split , system-filepath , text , text-icu , time- , uuid , moe @@ -61,5 +56,4 @@ Web.Geek.RSS Web.Geek.Runtime Web.Geek.Serve- Web.Geek.Spec Web.Geek.Type
src/Web/Geek/Config.hs view
@@ -20,7 +20,7 @@ import System.Environment (getArgs) import System.Exit (exitWith, ExitCode(..)) import System.Locale (defaultTimeLocale)-import Test.Hspec+ import Text.Printf import Web.Geek.DefaultConfig import Web.Geek.Type@@ -105,10 +105,3 @@ post_date_length :: String -> Integer post_date_length format = length - formatTime defaultTimeLocale format (def :: UTCTime)--spec :: Spec-spec = do- describe "Config" - do- it "should get date length" - do- post_date_length "%Y-%m-%d-" === 11-
− src/Web/Geek/ImportFromBamboo.hs
@@ -1,120 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoImplicitPrelude #-}--{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE QuasiQuotes #-}---module Web.Geek.ImportFromBamboo where--import Air.Data.Record.SimpleLabel hiding (get)-import Air.Env-import Air.Extra hiding (date)-import Air.Spec-import Air.TH (mkDefault, here)-import Control.Concurrent.Chan-import Control.Monad hiding (join)-import Data.Aeson.Generic (encode)-import Data.Function (on)-import Data.IORef-import Data.List (find)-import Data.List (sortBy)-import Data.Maybe (fromMaybe, catMaybes)-import Data.Text (Text)-import Data.Time (formatTime, fromGregorianValid, UTCTime(..))-import Data.UUID (toString)-import Filesystem.Path.CurrentOS (encodeString, decodeString)-import Hack2 (Application)-import Hack2.Contrib.Middleware.Static-import Hack2.Contrib.Utils (use, unescape_uri)-import Network.Curl-import Network.Miku-import Safe-import System.Directory-import System.FSNotify-import System.FilePath-import System.FilePath.Glob-import System.Locale (defaultTimeLocale)-import System.Random-import Test.Hspec-import Text.Printf-import Web.Geek.Application-import Web.Geek.Config-import Web.Geek.DefaultConfig-import Web.Geek.MarkupEngine.Markdown-import Web.Geek.Post-import Web.Geek.Type-import qualified Data.ByteString.Char8 as B-import qualified Data.Default as Default-import qualified Data.Text as T-import qualified Data.Text.IO as TextIO-import qualified Prelude as P----{---Description:--convert bamboo tag file format into front_matter style embeded format--Requiements:--put bamboo `blog` directory inside current directory-rename `blog/blog` to `blog/posts`-create a new empty directory `blog/posts2`--then run `get_post_from_path` from ghci---}--import Web.Geek.Config-import Web.Geek.Runtime- -convert_tags_from_bamboo :: IO ()-convert_tags_from_bamboo = do- let - _meta_tag_keyword = _config.meta_tag_keyword- _config = default_config- _posts <- get_posts _config [markdown]- - tags <- getDirectoryContents "blog/tag" ^ reject (belongs_to [".", ".."])- - tag_map <- tags.mapM (\tag -> TextIO.readFile - "blog/tag" / tag)- - - - -- puts - printf "tags: %s" - show tag_map- - let - find_tag post =- zip tags tag_map.map (\(tag_name, tag_content) ->- if post.title `T.isInfixOf` tag_content- then- Just tag_name- else- Nothing- )- .catMaybes- - forM_ _posts - \_post -> do- let _title = _post.title.T.unpack- if _post.meta.is []- then- case _post.find_tag of- [] ->- -- puts - printf "no tags found for %s" - _title- return ()- _tags -> do- -- puts - printf "found tags: %s for %s" (show _tags) _title- - let front_matter = "---\ncategories: " + _tags.join ", ".T.pack + "\n---\n\n"- - _body <- TextIO.readFile - _post.path- - let _export_path = "blog/posts2/" + _post.path.takeBaseName + ".md"- puts - "exporting: " + _export_path- TextIO.writeFile _export_path - front_matter + _body- else- -- puts - printf "%s has front_matter already" _title- return ()
src/Web/Geek/Post.hs view
@@ -19,24 +19,23 @@ import GHC.Exts( IsString(..) ) import System.FilePath import System.Locale-import Test.Hspec import Web.Geek.Config import Web.Geek.Type import qualified Data.Text as T import qualified Data.Map as Map post_tags :: Text -> Post -> [Text]-post_tags _meta_tag_keyword post = +post_tags _meta_tag_keyword post = case post.meta.Map.lookup _meta_tag_keyword of Nothing -> [] Just s -> s.T.splitOn ",".map T.strip post_link :: Post -> URIEscapedText-post_link post = - let +post_link post =+ let text_link = case post.date of- Just _date -> + Just _date -> let link_format = "%Y/%m/%d" prefix = T.pack - formatTime defaultTimeLocale link_format - _date.utctDay@@ -45,91 +44,48 @@ Nothing -> "post/" + post.title in- + text_link.T.unpack.fromString parse_title_and_date_from_path :: String -> FilePath -> (T.Text, Maybe UTCTime)-parse_title_and_date_from_path _post_date_format _path = +parse_title_and_date_from_path _post_date_format _path = let base_name = _path.takeBaseName _post_date_length = post_date_length - _post_date_format- + _title = base_name.drop _post_date_length _date = base_name.take _post_date_length.parseTime defaultTimeLocale _post_date_format in (_title.T.pack, _date)- + markup :: [MarkupEngine] -> FilePath -> Text -> HTMLText-markup markups _path _body = +markup markups _path _body = let ext = _path.takeExtension.dropWhile (is '.').pack in- + case markups.select (extensions > has ext) of [] -> transformer def _body _markup:_ -> transformer _markup _body parse_meta :: Text -> (Meta, Text)-parse_meta str = +parse_meta str = let no_meta = (def, str) in- + case str.T.stripStart.T.splitOn "---\n" of- (x:y:zs) -> - if x.T.all isSpace + (x:y:zs) ->+ if x.T.all isSpace then- let + let parse_line line = case line.T.splitOn ":" of w1:w2:[] -> Just (w1.strip, w2.strip) _ -> Nothing in- + let _meta = y.T.lines.reject (T.all isSpace).map parse_line.catMaybes .to_h in (_meta, zs.T.unlines.stripStart) else no_meta _ -> no_meta----- Spec--test_meta :: T.Text-test_meta = T.pack [here|------layout: post-categories: 日常------some thing--|]--spec :: Spec-spec = do- describe "Post" - do- it "should parse meta data" - do- parse_meta test_meta === ([("layout", "post"), ("categories", "日常")].to_h, "some thing\n\n\n")- - it "should parse title" - do- let _path = "blog/posts/2010-10-30-dummy title.md"- title_and_date = ("dummy title", parseTime defaultTimeLocale "%Y-%m-%d" "2010-10-30")- - parse_title_and_date_from_path "%Y-%m-%d-" _path === title_and_date- - {-- it "should markup" - do- let path = "blog/posts/2010-10-30-dummy title.md"- body = "### abc"- markup [markdown] path body === "<h3 id=\"abc\">abc</h3>"- -}- - it "should have tags" - do- let _post = def {meta = [("tags", "haskell, blog")].to_h} :: Post- post_tags "tags" _post === ["haskell", "blog"]- - it "should encode json" - do- let _post = def {meta = [("tags", "haskell, blog")].to_h} :: Post- - _post.encode.decode === Just _post
src/Web/Geek/Runtime.hs view
@@ -18,13 +18,11 @@ import Data.IORef import Data.List (sortBy) import Data.Text (Text)-import Data.UUID (toString) import Filesystem.Path.CurrentOS (encodeString, decodeString) import System.Directory import System.FSNotify import System.FilePath.Glob import System.Random-import Test.Hspec import Text.Printf import Web.Geek.DefaultConfig import Web.Geek.Post@@ -191,43 +189,3 @@ action (Added _path _) = callback - encodeString _path action (Modified _path _) = callback - encodeString _path action (Removed _path _) = callback - encodeString _path----spec :: Spec-spec = do- describe "Server" - do- let _config = default_config-- it "should list posts" - do- posts <- get_posts _config []-- posts `shouldSatisfy` (null > not)--- it "should callback on change" - do- let tmp_path = "tmp"- test_id <- randomIO ^ toString- let test_path = tmp_path / test_id-- createDirectoryIfMissing True test_path-- watch_manager <- startManager- path_chan <- newChan-- register_monitor watch_manager test_path - \file_path -> do- -- puts - printf "Changed: %s" file_path- writeChan path_chan file_path-- let test_case_id = "callback"- test_case_path = test_path / test_case_id-- B.writeFile test_case_path "Hello"- sleep (0.1 :: Double)- event_paths <- getChanContents path_chan- stopManager watch_manager-- test_case_full_path <- canonicalizePath test_case_path- removeDirectoryRecursive test_path-- event_paths `shouldSatisfy` (has test_case_full_path)
− src/Web/Geek/Spec.hs
@@ -1,14 +0,0 @@-{-# LANGUAGE NoImplicitPrelude #-}---module Web.Geek.Spec where--import Test.Hspec-import qualified Web.Geek.Post as Post-import qualified Web.Geek.Config as Config--spec :: Spec-spec = do- Post.spec- Config.spec-