1 {-# LANGUAGE CPP, OverloadedStrings #-}
    2 module Databrary.Main
    3     ( main
    4     -- * for tests
    5     , Flag (..)
    6     , flagConfig
    7     ) where
    8 
    9 import Control.Exception (evaluate)
   10 import Control.Monad (void)
   11 import Data.Either (partitionEithers)
   12 import qualified System.Console.GetOpt as Opt
   13 import System.Environment (getProgName, getArgs)
   14 import System.Exit (exitFailure)
   15 import qualified Network.Wai.Route as WaiRoute
   16 
   17 import qualified Databrary.Store.Config as Conf
   18 import Databrary.Service.Init (withService)
   19 import Databrary.Web.Rules (generateWebFiles)
   20 import Databrary.Action (actionRouteApp, WaiRouteApp(..))
   21 import Databrary.Action.Servant (servantApp)
   22 import Databrary.Routes (routeMapInvertible, routeMapWai)
   23 import Databrary.Warp (runWarp)
   24 
   25 
   26 data Flag
   27   = FlagConfig FilePath
   28   | FlagWeb
   29   | FlagEZID
   30   deriving (Show, Eq)
   31 
   32 opts :: [Opt.OptDescr Flag]
   33 opts =
   34   [ Opt.Option "c" ["config"] (Opt.ReqArg FlagConfig "FILE") "Path to configuration file [./databrary.conf]"
   35   , Opt.Option "w" ["webgen"] (Opt.NoArg FlagWeb) "Generate web assets only"
   36   , Opt.Option "e" ["ezid"] (Opt.NoArg FlagEZID) "Update EZID DOIs"
   37   ]
   38 
   39 flagConfig :: Flag -> Either FilePath Flag
   40 flagConfig (FlagConfig f) = Left f
   41 flagConfig f = Right f
   42 
   43 main :: IO () -- TODO: optparse
   44 main = do
   45   putStrLn "Starting Main..."
   46   prog <- getProgName
   47   args <- getArgs
   48   let (flags, args', err) = Opt.getOpt Opt.Permute opts args
   49       (configs, flags') = partitionEithers $ map flagConfig flags
   50 
   51   conf <- mconcat <$> mapM Conf.load (case configs of
   52     [] -> ["databrary.conf"]
   53     l -> l)
   54   case (flags', args', err) of
   55     ([FlagWeb], [], []) -> do
   56       putStrLn "generating files..." 
   57       void generateWebFiles
   58       putStrLn "finished generating web files..."
   59     {- seems like a good idea for testing and generally factoring out monolith, add back when used
   60     ([FlagEZID], [], []) -> do
   61       putStrLn "update EZID..."
   62       r <- withService False conf $ runContextM $ withBackgroundContextM updateEZID
   63       putStrLn "update EZID finished..."
   64       if r == Just True then pure () else exitFailure
   65     -}
   66     ([], [], []) -> do 
   67       putStrLn "No flags or args...."
   68       putStrLn "evaluating routemap..."
   69       routes <- evaluate routeMapInvertible
   70       putStrLn "evaluating routemap...withService..."
   71       -- Note: True = run in foreground
   72       withService True conf $ \rc -> do
   73         -- used to run migrations on startup when not in devel mode
   74         -- should check migrations2 table for last migration against last entry in schema2 dir
   75         putStrLn "running warp"
   76         runWarp
   77             conf
   78             rc
   79             (servantApp
   80                 (actionRouteApp
   81                     routes
   82                     (WaiRouteApp (WaiRoute.route (routeMapWai rc)))
   83                     rc
   84                 )
   85             )
   86     _ -> do
   87       mapM_ putStrLn err
   88       putStrLn $ Opt.usageInfo ("Usage: " ++ prog ++ " [OPTION...]") opts
   89       exitFailure