{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} module Villefort.Server where import Web.Scotty (scotty , get , html , post , body , redirect , html , param , file) import Control.Monad.Reader (liftIO,runReaderT) import Control.Concurrent (forkIO) import Data.Text.Lazy (pack) import Villefort.Database (addTask) import Villefort.Todo (deleteTodo,getTodos,updateTodos) import Villefort.Log (genStats) import Villefort.Definitions (VConfig(..)) import Villefort.Weekly (weeklyStats) import Paths_Villefort (getDataFileName,getDataDir) import Villefort.Daily (dailyCheck) import Villefort.New (makeNewPage) import Villefort.Today (getSummary) import Data.List.Split (splitOn) import System.Environment (getArgs) import System.Process (createProcess,proc,waitForProcess) import System.Directory (getAppUserDataDirectory,doesFileExist) import System.Posix.Process (executeFile) import Data.String.Utils (replace) -- | parses value from raw html post form getIndex :: [[Char]] -> Int -> [Char] getIndex str i = (Data.List.Split.splitOn "=" (str !! i)) !! 1 -- | Converts date from Javascript to sqlite date fromat convDate :: String -> String convDate date = newDate where splitDate = Data.List.Split.splitOn "%2F" date newDate = (splitDate !! 2) ++ "-" ++ (splitDate !! 0) ++ "-" ++ (splitDate !! 1) -- | Entry point for server attempts to recompile if needed villefort :: VConfig -> IO () villefort conf = do args <- getArgs case args of ["--custom",_] -> putStrLn "custom" >> launch conf ["--recompile"] -> putStrLn "recompiling" >> recompile _ -> putStrLn "straight starting " >> do if noCustom conf then launch conf >> putStrLn "overload" else checkCustomBuild >> launch conf -- | recompiles villefort by calling ghc expects .villefort/villefort.hs in home directory recompile :: IO () recompile = do dir <- getAppUserDataDirectory "villefort" let execPath = dir ++ "/villefort" sourcePath = dir ++"/villefort.hs" (_,_,_,pid) <- createProcess (proc "ghc" ["-o",execPath,sourcePath]) _ <- waitForProcess pid return () -- | checks for executable in villefort home folder if so it executes it checkCustomBuild :: IO () checkCustomBuild = do dir <- getAppUserDataDirectory "villefort" let path = dir ++ "/villefort" isBuild <- doesFileExist path dataDir <- getDataDir if isBuild then putStrLn "custom buil detected" >> executeFile path True ["--custom",dataDir] Nothing else putStrLn "no custom build :(" -- | actually launches the scotty server launch :: VConfig -> IO () launch conf = do _ <- forkIO $ dailyCheck conf scotty ( port conf) $ do get "/" $ do todos <- liftIO $ runReaderT getTodos conf html $ pack $ todos get "/new" $ do page <- liftIO $ runReaderT makeNewPage conf html $ pack page post "/delete" $ do rawHtml <- body runReaderT (deleteTodo rawHtml) conf redirect "/" post "/update" $ do rawHtml <- body let da = Data.List.Split.splitOn "&" (show rawHtml) let rawid = Data.List.Split.splitOn "=" $ (Prelude.init (da !! 1)) let sqlId = read (rawid!! 1) :: Int let rawtime = Data.List.Split.splitOn "=" $ (da !! 0) let insertTime = read (rawtime !! 1) :: Int liftIO $ runReaderT (updateTodos sqlId insertTime) conf redirect "/" post "/add" $ do rawBody <-body let parse = Data.List.Split.splitOn "&" (show rawBody) let rep = replace "+" " " . replace "%21" "!" . replace "%40" "@" . replace "%23" "#" . replace "%24" "$" . replace "%25" "%" . replace "%5E" "^" . replace "%26" "&" . replace "%28" "(" . replace "%29" ")" . replace "%2B" "+" let summary = rep $ getIndex parse 0 let date = convDate $ getIndex parse 3 let todoTitle = rep $ getIndex parse 1 let todoSubject = rep $ getIndex parse 2 liftIO $ runReaderT (addTask todoTitle summary date todoSubject) conf redirect "/" get "/today" $ do dat <-liftIO $ runReaderT getSummary conf html $ pack dat get "/templates/:asset" $ do asset <- param "asset" path <- liftIO $ getDataFileName $ "templates/" ++ asset file path get "/weekly" $ do to <- liftIO $ runReaderT weeklyStats conf html $ pack to get "/log" $ do page <- liftIO $runReaderT genStats conf html $ pack page