From 4a552e6388f371247b39df8c93b31273a5adf172 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Sun, 10 Jan 2016 07:09:25 -0800 Subject: [PATCH] api: refactor, try docopt --- hledger-api/hledger-api.cabal | 2 + hledger-api/hledger-api.hs | 112 ++++++++++++++++++---------------- hledger-api/package.yaml | 2 + 3 files changed, 63 insertions(+), 53 deletions(-) diff --git a/hledger-api/hledger-api.cabal b/hledger-api/hledger-api.cabal index 3b429a22d..e09d48021 100644 --- a/hledger-api/hledger-api.cabal +++ b/hledger-api/hledger-api.cabal @@ -42,7 +42,9 @@ executable hledger-api , hledger == 0.27 , base >= 4 && < 5 , aeson + , docopt , either + , safe , servant-server , text , transformers diff --git a/hledger-api/hledger-api.hs b/hledger-api/hledger-api.hs index 4fd7f7986..beb5720b1 100644 --- a/hledger-api/hledger-api.hs +++ b/hledger-api/hledger-api.hs @@ -2,9 +2,12 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +module Main where + import Control.Monad import Control.Monad.Trans.Either import Control.Monad.Trans.Reader @@ -15,26 +18,70 @@ import Data.Text import GHC.Generics import Network.Wai as Wai import Network.Wai.Handler.Warp as Warp +import Safe import Servant +import System.Console.Docopt +import System.Environment (getArgs) import System.IO import Text.Printf --- import Hledger hiding (Reader) -import Hledger.Cli hiding (Reader) +import Hledger.Cli hiding (Reader, version) +import System.Exit + +version="0.27.98" + +doc :: Docopt +doc = [docopt| +hledger-api 0.27.98 + +Usage: + hledger-api [options] + hledger-api --version + hledger-api --help + +Options: + -f --file FILE use a different input file + -p --port PORT use a different TCP port (default: 8001) + --version show version + -h --help show this help +|] + +main :: IO () +main = do + args <- getArgs >>= parseArgsOrExit doc + when (isPresent args (longOption "help")) $ exitWithUsage doc + when (isPresent args (longOption "version")) $ putStrLn version >> exitSuccess + let defp = "8001" + p <- case readMay $ getArgWithDefault args defp (longOption "port") of + Nothing -> exitWithUsage doc + Just n -> return n + deff <- defaultJournalPath + let f = getArgWithDefault args deff (longOption "file") + requireJournalFileExists f + readJournalFile Nothing Nothing True f >>= either error' (serveApi f p) + +-- serveApi :: CliOpts -> Journal -> IO () +serveApi :: FilePath -> Int -> Journal -> IO () +serveApi f p j = do + -- d <- getCurrentDay + -- let j' = + -- filterJournalTransactions (queryFromOpts d $ reportopts_ opts) $ + -- journalApplyAliases (aliasesFromOpts opts) $ + -- j + printf "Starting web api serving %s on port %d\nPress ctrl-c to quit\n" f p >> hFlush stdout + Warp.run p $ hledgerApiApp j --- boilerplate: hledgerApiApp :: Journal -> Wai.Application -hledgerApiApp j = Servant.serve hledgerApi (hledgerApiServer j) - -hledgerApiServer :: Journal -> Servant.Server HledgerApi -hledgerApiServer j = enter readerToEither hledgerServerT +hledgerApiApp j = Servant.serve hledgerApi hledgerApiServer where - readerToEither :: Reader Journal :~> EitherT ServantErr IO - readerToEither = Nat $ \r -> return (runReader r j) + hledgerApi :: Proxy HledgerApi + hledgerApi = Proxy -hledgerApi :: Proxy HledgerApi -hledgerApi = Proxy --- + hledgerApiServer :: Servant.Server HledgerApi + hledgerApiServer = Servant.enter readerToEither hledgerServerT + where + readerToEither :: Reader Journal :~> EitherT ServantErr IO + readerToEither = Nat $ \r -> return (runReader r j) type HledgerApi = "accounts" :> Get '[JSON] [AccountName] @@ -47,44 +94,3 @@ hledgerServerT = j <- ask return $ journalAccountNames j -main :: IO () -main = do - --- opts <- getHledgerWebOpts --- when (debug_ (cliopts_ opts) > 0) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts) --- runWith opts - - f <- defaultJournalPath - --- runWith :: WebOpts -> IO () --- runWith opts --- | "help" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStr (showModeHelp webmode) >> exitSuccess --- | "version" `inRawOpts` (rawopts_ $ cliopts_ opts) = putStrLn prognameandversion >> exitSuccess --- | otherwise = do --- requireJournalFileExists =<< (head `fmap` journalFilePathFromOpts (cliopts_ opts)) -- XXX head should be safe for now - requireJournalFileExists f --- withJournalDo' opts web - --- withJournalDo' :: WebOpts -> (WebOpts -> Journal -> IO ()) -> IO () --- withJournalDo' opts cmd = do --- f <- head `fmap` journalFilePathFromOpts (cliopts_ opts) -- XXX head should be safe for now - - -- https://github.com/simonmichael/hledger/issues/202 - -- -f- gives [Error#yesod-core] : hGetContents: illegal operation (handle is closed) for some reason - -- Also we may be writing to this file. Just disallow it. - when (f == "-") $ error' "-f -, please specify a file path" - - let opts = defcliopts - readJournalFile Nothing Nothing True f >>= - either error' (go opts . journalApplyAliases (aliasesFromOpts opts)) - -go :: CliOpts -> Journal -> IO () -go opts j = do - d <- getCurrentDay - let j' = filterJournalTransactions (queryFromOpts d $ reportopts_ opts) j - p = 8001 :: Int - _ <- printf "Starting web api on port %d\n" p - putStrLn "Press ctrl-c to quit" - hFlush stdout - - Warp.run 8001 $ hledgerApiApp j' diff --git a/hledger-api/package.yaml b/hledger-api/package.yaml index 4061eb23e..96e7d87c1 100644 --- a/hledger-api/package.yaml +++ b/hledger-api/package.yaml @@ -154,7 +154,9 @@ executables: - hledger == 0.27 - base >= 4 && < 5 - aeson + - docopt - either + - safe - servant-server - text - transformers