api: refactor, try docopt

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

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, version)
-import Hledger.Cli hiding (Reader)
+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)
+hledgerApiApp j = Servant.serve hledgerApi hledgerApiServer
-
-hledgerApiServer :: Journal -> Servant.Server HledgerApi
-hledgerApiServer j = enter readerToEither hledgerServerT
   where
-    readerToEither :: Reader Journal :~> EitherT ServantErr IO
+    hledgerApi :: Proxy HledgerApi
-    readerToEither = Nat $ \r -> return (runReader r j)
+    hledgerApi = Proxy
 
-hledgerApi :: Proxy HledgerApi
+    hledgerApiServer :: Servant.Server HledgerApi
-hledgerApi = Proxy
+    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] <stdin>: 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'

hledger-api/package.yaml

@@ -154,7 +154,9 @@ executables:
       - hledger          == 0.27
       - base             >= 4 && < 5
       - aeson
+      - docopt
       - either
+      - safe
       - servant-server
       - text
       - transformers