{-# 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
  { Options -> String
optQuery :: String
  , Options -> Maybe String
optAppCacheDir :: Maybe FilePath
  , Options -> Maybe CacheOption
optCache :: Maybe CacheOption
  , Options -> Maybe HoogleUrl
optHoogle :: Maybe HoogleUrl
  , Options -> Maybe HackageUrl
optHackage :: Maybe HackageUrl
  }


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

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


main :: IO ()
IO ()
main = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ do
  Options{String
Maybe String
Maybe HackageUrl
Maybe HoogleUrl
Maybe CacheOption
optHackage :: Maybe HackageUrl
optHoogle :: Maybe HoogleUrl
optCache :: Maybe CacheOption
optAppCacheDir :: Maybe String
optQuery :: String
optHackage :: Options -> Maybe HackageUrl
optHoogle :: Options -> Maybe HoogleUrl
optCache :: Options -> Maybe CacheOption
optAppCacheDir :: Options -> Maybe String
optQuery :: Options -> String
..} <- forall a. ParserInfo a -> IO a
O.execParser ParserInfo Options
cliOptions
  Manager
manager <- ManagerSettings -> IO Manager
Http.newManager ManagerSettings
Http.tlsManagerSettings
  AppCache
appCache <- Maybe String -> IO AppCache
mkAppCacheDir Maybe String
optAppCacheDir
  EvictionPolicy
policy <- Maybe CacheOption -> AppCache -> IO EvictionPolicy
cachePolicy Maybe CacheOption
optCache AppCache
appCache
  Cache
cache <- forall (m :: * -> *). MonadIO m => EvictionPolicy -> m Cache
Cache.create EvictionPolicy
policy
  Bool
isTTY <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
  let state :: ShellState
state = ShellState
        { sContext :: Context
sContext = Context
ContextEmpty
        , sManager :: Manager
sManager = Manager
manager
        , sCache :: Cache
sCache = Cache
cache
        , sNoColours :: Bool
sNoColours = Bool -> Bool
not Bool
isTTY
        , sHoogle :: HoogleUrl
sHoogle = forall a. a -> Maybe a -> a
fromMaybe HoogleUrl
defaultHoogleUrl Maybe HoogleUrl
optHoogle
        , sHackage :: HackageUrl
sHackage = forall a. a -> Maybe a -> a
fromMaybe HackageUrl
defaultHackageUrl Maybe HackageUrl
optHackage
        }
  forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync (forall (m :: * -> *). MonadIO m => EvictionPolicy -> m ()
Cache.enforce EvictionPolicy
policy) forall a b. (a -> b) -> a -> b
$ \Async ()
_ ->
    forall a. ShellState -> M a -> IO (Either String a)
runCLI ShellState
state forall a b. (a -> b) -> a -> b
$
      case String
optQuery of
        String
""    -> M ()
interactive
        String
input -> String -> M ()
evaluate String
input

main' :: IO ()
main' :: IO ()
main' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ do
  Options{} <- forall a. ParserInfo a -> IO a
O.execParser ParserInfo Options
cliOptions
  Manager
manager <- ManagerSettings -> IO Manager
Http.newManager ManagerSettings
Http.tlsManagerSettings
  AppCache
appCache <- Maybe String -> IO AppCache
mkAppCacheDir forall a. Maybe a
Nothing
  EvictionPolicy
policy <- Maybe CacheOption -> AppCache -> IO EvictionPolicy
cachePolicy forall a. Maybe a
Nothing AppCache
appCache
  Cache
cache <- forall (m :: * -> *). MonadIO m => EvictionPolicy -> m Cache
Cache.create EvictionPolicy
policy
  let state :: ShellState
state = ShellState
        { sContext :: Context
sContext = Context
ContextEmpty
        , sManager :: Manager
sManager = Manager
manager
        , sCache :: Cache
sCache = Cache
cache
        , sNoColours :: Bool
sNoColours = Bool
False
        , sHoogle :: HoogleUrl
sHoogle = HoogleUrl
defaultHoogleUrl
        , sHackage :: HackageUrl
sHackage = HackageUrl
defaultHackageUrl
        }
  forall a. ShellState -> M a -> IO (Either String a)
runCLI ShellState
state forall a b. (a -> b) -> a -> b
$ do
    Cmd -> M ()
evaluateCmd (Selection -> Cmd
ViewDeclaration  forall a b. (a -> b) -> a -> b
$ String -> Selection
Search String
"completeWord +haskeline")