dixi-0.6: main/Main.hs

{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE PolyKinds         #-}
{-# LANGUAGE TypeFamilies      #-}
{-# LANGUAGE TypeOperators     #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE CPP               #-}
{-# LANGUAGE ConstraintKinds   #-}

import Control.Exception(bracket)
import Control.Monad
import Data.Acid
import Network.Wai.Handler.Warp
import Servant
import System.Directory
import System.FilePath
import System.Environment
import System.Exit
import System.IO

import qualified Data.Yaml         as Y
import qualified Data.Text.Lazy.IO as L

import Dixi.API
import Dixi.Config
import Dixi.Database
import Dixi.Forms  () -- imported for orphans
import Dixi.Server
import Dixi.Markup (defaultStylesheet)

getChar' :: IO Char
getChar' =
  bracket (hGetBuffering stdin)
          (hSetBuffering stdin)
          $ const $ do
             hSetBuffering stdin NoBuffering
             bracket (hGetEcho stdin)
                     (hSetEcho stdin)
                     $ const $ hSetEcho stdin False >> getChar

handleStatics, handleStylesheet :: FilePath -> IO ()

handleStatics fn = do
  c <- doesDirectoryExist fn
  unless c $ do
    putStrLn "Statics directory not found, would you like to [c]reate it, or e[x]it?"
    getChar' >>= \i -> case i of
      _ | i `elem` ("cC" :: String) -> createDirectory fn
        | otherwise                 -> exitFailure

handleStylesheet fn = do
  c <- doesFileExist fn
  unless c $ do
    putStrLn "Stylesheet file not found, would you like to [c]reate one, or e[x]it?"
    getChar' >>= \i -> case i of
      _ | i `elem` ("cC" :: String) -> L.writeFile fn defaultStylesheet
        | otherwise                 -> exitFailure

handleConfig :: FilePath -> IO (Either Y.ParseException Config)
handleConfig fn = do
  c <- doesFileExist fn
  if c then Y.decodeFileEither fn
       else do
    putStrLn "Configuration file not found, would you like to [c]reate one, [r]un with default configuration or e[x]it?"
    getChar' >>= \i -> case i of
      _ | i `elem` ("cC" :: String) -> Y.encodeFile fn defaultConfig >> return (Right defaultConfig)
        | i `elem` ("rR" :: String) -> return (Right defaultConfig)
        | otherwise                 -> exitFailure


dixiWithStatic :: Proxy (Dixi :| "static" :> Raw)
dixiWithStatic =  Proxy

main :: IO ()
main = getArgs >>= main'
 where
   main' []  = main' ["config.yaml"]
   main' [x] = handleConfig x >>= main''
   main' _ = do
     p <- getProgName
     hPutStrLn stderr $ "usage:\n   " ++ p ++ " [/path/to/config.yaml]"
     exitFailure
   main'' (Left e) = do
     hPutStrLn stderr $ Y.prettyPrintParseException e
     exitFailure
   main'' (Right cfg@(Config {..})) = do
     case static of
       Just st -> do
         handleStatics st
         handleStylesheet (st </> stylesheet)
       Nothing -> return ()
     db <- openLocalStateFrom storage emptyDB
     createCheckpoint db
     createArchive    db
     rs <- configToRenders cfg
     putStrLn "Starting dixi"
     run port $ case static of
       Just st -> serve dixiWithStatic $ server db rs |: serveDirectory st
       Nothing -> serve dixi $ server db rs