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