{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE NoImplicitPrelude #-} module Web.Geek.Runtime 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, get) import Control.Monad.Reader (ask) import Data.Aeson.Generic (encode, decode) import Data.Function (on) import Data.IORef import Data.List (find, sort) import Data.List (sortBy) import Data.Map (Map) import Data.Map (toAscList) import Data.Maybe (fromMaybe, catMaybes) import Data.Text (Text) import Data.Text.Encoding import Data.Time (formatTime, fromGregorianValid, UTCTime(..)) import Data.UUID (toString) import Filesystem.Path.CurrentOS (encodeString, decodeString) import Network.Miku hiding (json) import Network.Miku.Type (AppMonadT) import Safe (readMay) 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.Config import Web.Geek.Post import Web.Geek.Type import qualified Data.ByteString.Char8 as B import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.ICU as ICU import qualified Data.Text.IO as TextIO import qualified Network.Miku as Miku import qualified Prelude as P build_markup_engines :: [Text] -> [MarkupEngine] -> [MarkupEngine] build_markup_engines user_markup_engine_names _markup_engines = _markup_engines.select (markup_engine_name > belongs_to user_markup_engine_names) get_post_from_path :: Config -> [MarkupEngine] -> FilePath -> IO Post get_post_from_path _config _markup_engines _path = do let _meta_tag_keyword = _config.meta_tag_keyword content <- TextIO.readFile _path let (_title, _date) = parse_title_and_date_from_path (_config.post_date_format) _path (_meta, _raw_body) = parse_meta (content) _body = markup _markup_engines _path _raw_body _raw_body_for_search = if (_config.full_text_search) then _raw_body else def _post = def { title = _title , date = _date , path = _path , body = _body , meta = _meta , raw_body = _raw_body_for_search } _link = post_link _post _tags = post_tags _meta_tag_keyword _post return - _post .set __link _link .set __tags _tags glob_dir :: String -> FilePath -> IO [String] glob_dir pattern path = globDir1 (compile pattern) path get_posts :: Config -> [MarkupEngine] -> IO [Post] get_posts _config _markup_engines = do putStr - "Loading Posts ... " post_paths <- glob_dir "*" (_config.blog_directory / _config.post_directory) posts <- forM post_paths - get_post_from_path _config _markup_engines puts - "Done!" return - posts.sortBy (compare `on` date).reverse monitor_posts :: Config -> [MarkupEngine] -> Chan Event -> IORef [Post] -> IO () monitor_posts _config _markup_engines events posts_ref = do last_event_time_stamp <- now >>= newIORef last_update_time_stamp <- now >>= newIORef let record_event = do e <- readChan events -- printf "Caught: %s\n" - show e time_stamp <- now writeIORef last_event_time_stamp time_stamp fork - forever record_event let lazy_update = do sleep 0.1 event_time <- readIORef last_event_time_stamp update_time <- readIORef last_update_time_stamp if event_time P.> update_time then do get_posts _config _markup_engines >>= writeIORef posts_ref now >>= writeIORef last_update_time_stamp else return () forever lazy_update initialize_runtime :: Config -> [MarkupEngine] -> IO Runtime initialize_runtime _config app_markups_engines = do let _markup_engines = build_markup_engines (_config.markup_engine_names) app_markups_engines -- puts - "markup engine length: " + _markup_engines.length.show _posts <- get_posts _config _markup_engines _posts_ref <- newIORef _posts let _full_text_search_map = if not - _config.full_text_search then def else zip [0,1..] _posts .map ((\(_id, _post) -> let _full_text = _post.title + " " + _post.raw_body in zip (_full_text.ICU.toLower ICU.Current .T.words) (repeat [_id]) )) .concat .Map.fromListWith ((++)) -- puts "Building full text search database ..." _full_text_search_map_ref <- newIORef _full_text_search_map -- print - _full_text_search_map.Map.toAscList.take 50 printf "Search database has %i unique keywords." (_full_text_search_map.Map.size) fork - withManager - \watch_manager -> do events <- newChan :: (IO (Chan Event)) fork - monitor_posts _config _markup_engines events _posts_ref let post_watch_file_path = decodeString - _config.blog_directory / _config.post_directory watchTreeChan watch_manager post_watch_file_path (const True) events forever - sleep 1000 return - def { posts_ref = _posts_ref , markup_engines = _markup_engines , config = _config , full_text_search_map_ref = _full_text_search_map_ref }