{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Haskell.Ide.Engine.Support.Hoogle where

import           Control.Monad.IO.Class
import           Control.Monad (join)
import           Control.Exception
import           Control.Applicative (liftA2)
import           Data.Aeson
import           Data.Bifunctor
import           Data.Maybe
import qualified Data.Text                          as T
import Data.List
import           Haskell.Ide.Engine.MonadTypes
import           Haskell.Ide.Engine.MonadFunctions
import           Hoogle
import           System.Directory
import           System.Environment
import           Text.HTML.TagSoup
import           Text.HTML.TagSoup.Tree

-- ---------------------------------------------------------------------

data HoogleError
  = NoDb
  | DbFail T.Text
  | NoResults
  deriving (Eq,Ord,Show)

newtype HoogleDb = HoogleDb (Maybe FilePath)

-- | Convert Hoogle Error's to Ide Error's.
-- Can be used to present errors to the client.
hoogleErrorToIdeError :: HoogleError -> IdeError
hoogleErrorToIdeError NoResults =
  IdeError PluginError "No results found" Null
hoogleErrorToIdeError NoDb =
  IdeError PluginError "Hoogle database not found. Run hoogle generate to generate" Null
hoogleErrorToIdeError (DbFail msg) =
  IdeError PluginError ("Hoogle failed with following error: " <> msg) Null

instance ExtensionClass HoogleDb where
  initialValue = HoogleDb Nothing

-- | Initialise the Hoogle Database.
-- Search for the Hoogle Database and set it in the global config if found.
-- Looks first into custom hoogle database locations, then in the default location.
-- Note, that the FilePath must be an absolute path, otherwise Hoogle can not
-- find the database.
--
-- If no hoogle database has been found, Nothing is returned
-- and we will have no access to the hoogle database.
-- However, it is still safe to use the hoogle API,
-- e.g. either error or default values are returned.
initializeHoogleDb :: IdeGhcM (Maybe FilePath)
initializeHoogleDb = do
  explicitDbLocation <- liftIO $ lookupEnv "HIE_HOOGLE_DATABASE"
  db' <- maybe (liftIO defaultDatabaseLocation) pure explicitDbLocation
  db <- liftIO $ makeAbsolute db'
  exists <- liftIO $ doesFileExist db
  if exists then do
    put $ HoogleDb $ Just db
    return $ Just db
  else
    return Nothing

info :: T.Text -> IdeM (Either HoogleError T.Text)
info expr = do
  HoogleDb mdb <- get
  liftIO $ runHoogleQuery mdb expr $ \case
    [] -> Left NoResults
    h:_ -> return $ renderTargetInfo h

renderTargetInfo :: Target -> T.Text
renderTargetInfo t =
  T.intercalate "\n"
    $  ["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "\n```"]
    ++ [renderDocs $ targetDocs t]
    ++ [T.pack $ curry annotate "More info" $ targetURL t]

-- | Command to get the prettified documentation of an hoogle identifier.
-- Identifier should be understandable for hoogle.
-- If documentation can be found for it, the result will be rendered
-- in markdown for the lsp-client. If multiple results have been found,
-- only the first result will be shown.
--
-- If no result can be found for the identifier, a hoogle error is returned
-- that can be shown to the client by converting it
-- to an IdeError with 'hoogleErrorToIdeError'.
infoFancyRender :: T.Text -> IdeM (Either HoogleError T.Text)
infoFancyRender expr = do
  HoogleDb mdb <- get
  liftIO $ runHoogleQuery mdb expr $ \case
    [] -> Left NoResults
    h:_ -> return $ renderTarget h

-- | Render the target in valid markdown.
-- Transform haddock documentation into markdown.
renderTarget :: Target -> T.Text
-- renderTarget t = T.intercalate "\n\n" $
renderTarget t = T.intercalate "\n" $
     ["```haskell\n" <> unHTML (T.pack $ targetItem t) <> "```"]
  ++ [T.pack $ unwords mdl | not $ null mdl]
  ++ [renderDocs $ targetDocs t]
  ++ [T.pack $ curry annotate "More info" $ targetURL t]
  where mdl = map annotate $ catMaybes [targetPackage t, targetModule t]

annotate :: (String, String) -> String
annotate (thing,url) = "["<>thing<>"]"<>"("<>url<>")"

-- | Hoogle results contain html like tags.
-- We remove them with `tagsoup` here.
-- So, if something hoogle related shows html tags,
-- then maybe this function is responsible.
unHTML :: T.Text -> T.Text
unHTML = T.replace "<0>" "" . innerText . parseTags

renderDocs :: String -> T.Text
renderDocs = T.concat . map htmlToMarkDown . parseTree . T.pack

htmlToMarkDown :: TagTree T.Text -> T.Text
htmlToMarkDown (TagLeaf x) = fromMaybe "" $ maybeTagText x
htmlToMarkDown (TagBranch "i" _ tree) = "*" <> T.concat (map htmlToMarkDown tree) <> "*"
htmlToMarkDown (TagBranch "b" _ tree) = "**" <> T.concat (map htmlToMarkDown tree) <> "**"
htmlToMarkDown (TagBranch "a" _ tree) = "`" <> T.concat (map htmlToMarkDown tree) <> "`"
htmlToMarkDown (TagBranch "li" _ tree) = "- " <> T.concat (map htmlToMarkDown tree)
htmlToMarkDown (TagBranch "tt" _ tree) = "`" <> innerText (flattenTree tree) <> "`"
htmlToMarkDown (TagBranch "pre" _ tree) = "```haskell\n" <> T.concat (map htmlToMarkDown tree) <> "```"
htmlToMarkDown (TagBranch _ _ tree) = T.concat $ map htmlToMarkDown tree

------------------------------------------------------------------------

-- | Search for modules that satisfy the given search text.
-- Will return at most five, unique results.
--
-- If an error occurs, such as no hoogle database has been found,
-- or the search term has no match, an empty list will be returned.
searchModules :: T.Text -> IdeM [T.Text]
searchModules = fmap (map fst) . searchModules'

-- | Just like 'searchModules', but includes the signature of the search term
-- that has been found in the module.
searchModules' :: T.Text -> IdeM [(T.Text, T.Text)]
searchModules' = fmap (take 5 . nub) . searchTargets retrieveModuleAndSignature
  where
    retrieveModuleAndSignature :: Target -> Maybe (T.Text, T.Text)
    retrieveModuleAndSignature target = liftA2 (,) (packModuleName target) (packSymbolSignature target)

    packModuleName :: Target -> Maybe T.Text
    packModuleName = fmap (T.pack . fst) . targetModule

    packSymbolSignature :: Target -> Maybe T.Text
    packSymbolSignature = Just . unHTML . T.pack . targetItem

-- | Search for packages that satisfy the given search text.
-- Will return at most five, unique results.
--
-- If an error occurs, such as no hoogle database has been found,
-- or the search term has no match, an empty list will be returned.
searchPackages :: T.Text -> IdeM [T.Text]
searchPackages = fmap (take 5 . nub) . searchTargets (fmap (T.pack . fst) . targetPackage)

-- | Search for Targets that fit to the given Text and satisfy the given predicate.
-- Limits the amount of matches to at most ten.
-- Applies the predicate to the first ten matches. May also return zero matches,
-- although there are matches, if none of the first ten matches
-- satisfies the predicate.
--
-- If an error occurs, such as no hoogle database has been found,
-- or the search term has no match, an empty list will be returned.
searchTargets :: (Target -> Maybe a) -> T.Text -> IdeM [a]
searchTargets f term = do
  HoogleDb mdb <- get
  res <- liftIO $ runHoogleQuery mdb term (Right . mapMaybe f . take 10)
  case bimap hoogleErrorToIdeError id res of
    Left _ -> return []
    Right xs -> return xs

------------------------------------------------------------------------

-- | 'lookup' @n term@ looks up the given Text in the local Hoogle database.
-- Takes the first @n@ matches.
-- May fail with a HoogleError that can be shown to the user.
lookup :: Int -> T.Text -> IdeM (Either HoogleError [T.Text])
lookup n term = do
  HoogleDb mdb <- get
  liftIO $ runHoogleQuery mdb term $
    Right . map (T.pack . targetResultDisplay False) . take n

------------------------------------------------------------------------

-- | Run a query for Hoogle on the given Hoogle database.
-- If no Database is given, no search is executed.
-- If the Database cannot be found at the given location, an IOException will be thrown.
-- Note, that the database file must be an absolute path.
-- The target may be of the form: 'take', 'take :: Int -> [a] -> [a]', 'Data.List'.
-- In general, it is very similar to the Web Api.
-- Found targets can be consumed with the given callback function.
-- You can limit the amount of results, by taking only the first ten results.
-- Example call:
--
-- @
--   runHoogleQuery
--    (Just "/home/user/.hoogle/default-haskell-5.0.17.hoo")
--    (Data.Text.pack "take :: Int -> [a] -> [a]")
--    (Right . Prelude.take 10)
-- @
-- This limits the results to ten and looks for a function `take` that has the given signature.
--
-- HoogleError's can be translated to IdeErrors with @hoogleErrorToIdeError@
-- and shown to the client.
runHoogleQuery :: Maybe FilePath -> T.Text -> ([Target] -> Either HoogleError a) -> IO (Either HoogleError a)
runHoogleQuery Nothing _ _ = return $ Left NoDb
runHoogleQuery (Just db) quer f = do
  res <- try (searchHoogle db quer) :: IO (Either ErrorCall [Target])
  return . join $ bimap (DbFail . T.pack . show) f res


-- | Run a query for Hoogle on the given Hoogle database.
-- If the database can not be found, an IOException is thrown.
-- The target may be of the form: `take`, `take :: Int -> [a] -> [a]`
searchHoogle :: FilePath -> T.Text -> IO [Target]
searchHoogle dbf quer = withDatabase dbf (return . flip searchDatabase (T.unpack quer))

------------------------------------------------------------------------

docRules :: Maybe T.Text -> T.Text -> T.Text
docRules (Just "base") "GHC.Base"    = "Prelude"
docRules (Just "base") "GHC.Enum"    = "Prelude"
docRules (Just "base") "GHC.Num"     = "Prelude"
docRules (Just "base") "GHC.Real"    = "Prelude"
docRules (Just "base") "GHC.Float"   = "Prelude"
docRules (Just "base") "GHC.Show"    = "Prelude"
docRules (Just "containers") modName =
  fromMaybe modName $ T.stripSuffix ".Base" modName
docRules _ modName = modName

-- | Get the Documentation for a given identifier in a given module.
-- May also specify the according package, to avoid name clashes.
-- Results is a prettified Text that can be sent and shown to the client.
--
-- Might fail, if the identifier can not be found.
getDocsForName :: T.Text -- ^ Identifier within a module.
               -> Maybe T.Text -- ^ Optional package name to avoid name clashes.
               -> T.Text -- ^ Name of the module to search in.
               -> IdeM (Maybe T.Text) -- ^ Prettified hoogle documentation of target.
getDocsForName name pkg modName' = do
  let modName = docRules pkg modName'
      query = name
           <> maybe "" (T.append " package:") pkg
           <> " module:" <> modName
           <> " is:exact"
  debugm $ "hoogle query: " ++ T.unpack query
  res <- infoFancyRender query
  case res of
    Right x -> return $ Just x
    Left _ -> return Nothing