haskell-docs-cli-1.0.0.0: src/Main.hs

{-# LANGUAGE ApplicativeDo #-}
module Main where

import Docs.CLI.Directory
  ( AppCache(..)
  , mkAppCacheDir
  )
import Docs.CLI.Evaluate
  ( interactive
  , evaluate
  , evaluateCmd
  , ShellState(..)
  , Context(..)
  , Cmd(..)
  , Selection(..)
  , HackageUrl(..)
  , HoogleUrl(..)
  , runCLI
  , defaultHackageUrl
  , defaultHoogleUrl
  , moreInfoText
  )

import Control.Concurrent.Async (withAsync)
import Control.Applicative (many, (<|>), optional)
import Control.Monad (void)
import Data.Maybe (fromMaybe)
import qualified Network.HTTP.Client.TLS as Http (tlsManagerSettings)
import qualified Network.HTTP.Client as Http
import qualified Options.Applicative as O
import qualified Options.Applicative.Help.Pretty as OP
import System.Environment (getEnv)
import System.FilePath.Posix ((</>))
import System.Directory (createDirectoryIfMissing, getHomeDirectory, getXdgDirectory, XdgDirectory(..))
import System.IO (hIsTerminalDevice, stdout)

import Data.Cache as Cache

data CacheOption = Unlimited | Off

data Options = Options
  { optQuery :: String
  , optAppCacheDir :: Maybe FilePath
  , optCache :: Maybe CacheOption
  , optHoogle :: Maybe HoogleUrl
  , optHackage :: Maybe HackageUrl
  }


cachePolicy :: Maybe CacheOption -> AppCache -> IO Cache.EvictionPolicy
cachePolicy mCacheOpt (AppCache dir) =
  case mCacheOpt of
    Just Off -> return Cache.NoStorage
    Just Unlimited -> eviction Cache.NoMaxBytes Cache.NoMaxAge
    Nothing -> eviction (Cache.MaxBytes $ 100 * mb) (Cache.MaxAgeDays 20)
  where
    mb = 1024 * 1024
    eviction bytes age = do
      createDirectoryIfMissing True dir
      return $ Cache.Evict bytes age (Store dir)

cliOptions :: O.ParserInfo Options
cliOptions = O.info (O.helper <*> parser) $ mconcat
  [ O.fullDesc
  , O.headerDoc $ Just $ OP.vcat
    [ "haskell-docs-cli"
    , ""
    , OP.indent 2 $ OP.vcat
      [ "Search Hoogle and view Hackage documentation from the command line."
      , "Search modules, packages, types and functions by name or by approximate type signature."
      ]
    ]
  , O.footerDoc $ Just $ moreInfoText <> OP.linebreak
  ]
  where
    parser = do
      optQuery <- fmap unwords . many $ O.strArgument $ O.metavar "CMD"
      optAppCacheDir <- optional $ O.strOption $ mconcat
        [ O.long "cache-dir"
        , O.metavar "PATH"
        , O.help "Specify the directory for application cache (default: XDG_CACHE_HOME/haskell-docs-cli)."
        ]
      optCache <- optional $ O.option readCache $ mconcat
        [ O.long "cache"
        , O.metavar "unlimited|off"
        , O.help "Set a custom cache eviction policy"
        ]
      optHoogle <- optional $ fmap HoogleUrl $ O.strOption $ mconcat
        [ O.long "hoogle"
        , O.metavar "URL"
        , O.help "Address of Hoogle instance to be used"
        ]
      optHackage <- optional $ fmap HackageUrl $ O.strOption $ mconcat
        [ O.long "hackage"
        , O.metavar "URL"
        , O.help "Address of Hackage instance to be used"
        ]
      pure $ Options {..}
      where
        readCache  = O.maybeReader $ \str ->
          case str of
            "unlimited" -> Just Unlimited
            "off" -> Just Off
            _ -> Nothing


main :: IO ()
main = void $ do
  Options{..} <- O.execParser cliOptions
  manager <- Http.newManager Http.tlsManagerSettings
  appCache <- mkAppCacheDir optAppCacheDir
  policy <- cachePolicy optCache appCache
  cache <- Cache.create policy
  isTTY <- hIsTerminalDevice stdout
  let state = ShellState
        { sContext = ContextEmpty
        , sManager = manager
        , sCache = cache
        , sNoColours = not isTTY
        , sHoogle = fromMaybe defaultHoogleUrl optHoogle
        , sHackage = fromMaybe defaultHackageUrl optHackage
        }
  withAsync (Cache.enforce policy) $ \_ ->
    runCLI state $
      case optQuery of
        ""    -> interactive
        input -> evaluate input

main' :: IO ()
main' = void $ do
  Options{} <- O.execParser cliOptions
  manager <- Http.newManager Http.tlsManagerSettings
  appCache <- mkAppCacheDir Nothing
  policy <- cachePolicy Nothing appCache
  cache <- Cache.create policy
  let state = ShellState
        { sContext = ContextEmpty
        , sManager = manager
        , sCache = cache
        , sNoColours = False
        , sHoogle = defaultHoogleUrl
        , sHackage = defaultHackageUrl
        }
  runCLI state $ do
    evaluateCmd (ViewDeclaration  $ Search "completeWord +haskeline")