{-# 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 Control.Concurrent.Chan
import Control.Monad hiding (join)
import Data.Function (on)
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
import Web.Geek.Type
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.ICU as ICU
import qualified Data.Text.IO as TextIO
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
      _ <- 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 :: Double)
      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
  
  puts - 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 :: Double)
  
  return - 
    def 
      { 
        posts_ref = _posts_ref
      , markup_engines = _markup_engines
      , config = _config
      , full_text_search_map_ref = _full_text_search_map_ref
      }

register_monitor :: WatchManager -> FilePath -> (FilePath -> IO ()) -> IO ()
register_monitor manager _path callback = do
  -- printf "reigister_with_path: %s\n" path
  -- 
  watchTree manager (decodeString _path) (const True) (\event -> do
    -- puts - show event
    action event
    )
  where
    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)