{-# LANGUAGE OverloadedStrings #-}

module HsDev.Tools.Hayoo (
	-- * Types
	HayooResult(..), HayooSymbol(..),
	hayooAsSymbol,
	-- * Search help online
	hayoo,
	-- * Utils
	untagDescription,

	-- * Reexportss
	module Control.Monad.Except
	) where

import Control.Arrow
import Control.Applicative
import Control.Lens (lens)
import Control.Monad.Except

import Data.Aeson
import qualified Data.ByteString.Lazy.Char8 as L
import Data.Either
import Data.Maybe (listToMaybe, fromJust)
import Network.HTTP.Client
import Network.URI (escapeURIString, isUnescapedInURIComponent)
import Data.String (fromString)
import qualified Data.Text as T (unpack, unlines)

import HsDev.Symbols
import HsDev.Tools.Base (replaceRx)
import HsDev.Util

-- | Hayoo response
data HayooResult = HayooResult {
	resultMax :: Int,
	resultOffset :: Int,
	resultCount :: Int,
	resultResult :: [HayooSymbol] }
		deriving (Eq, Ord, Read, Show)

-- | Hayoo symbol
data HayooSymbol = HayooSymbol {
	resultUri :: String,
	tag :: String,
	hayooPackage :: String,
	hayooName :: String,
	hayooSource :: String,
	hayooDescription :: String,
	hayooSignature :: String,
	hayooModules :: [String],
	hayooScore :: Double,
	hayooType :: String }
		deriving (Eq, Ord, Read, Show)

newtype HayooValue = HayooValue { hayooValue :: Either Value HayooSymbol }

instance FromJSON HayooResult where
	parseJSON = withObject "hayoo response" $ \v -> HayooResult <$>
		(v .:: "max") <*>
		(v .:: "offset") <*>
		(v .:: "count") <*>
		((rights . map hayooValue) <$> (v .:: "result"))

instance Sourced HayooSymbol where
	sourcedName = lens g' s' where
		g' = fromString . hayooName
		s' sym n = sym { hayooName = T.unpack n }
	sourcedModule = lens g' s' where
		g' h = ModuleId nm (OtherLocation $ fromString $ resultUri h) where
			nm = maybe mempty fromString $ listToMaybe $ hayooModules h
		s' h _ = h
	sourcedDocs f h = (\d' -> h { hayooDescription = T.unpack d' }) <$> f (fromString $ hayooDescription h)

instance Documented HayooSymbol where
	brief f
		| hayooType f == "function" = fromString $ hayooName f ++ " :: " ++ hayooSignature f
		| otherwise = fromString $ hayooType f ++ " " ++ hayooName f
	detailed f = T.unlines $ defaultDetailed f ++ map fromString online where
		online = [
			"", "Hayoo online documentation", "",
			"Package: " ++ hayooPackage f,
			"Hackage URL: " ++ resultUri f]

instance FromJSON HayooSymbol where
	parseJSON = withObject "symbol" $ \v -> HayooSymbol <$>
		(v .:: "resultUri") <*>
		(v .:: "tag") <*>
		(v .:: "resultPackage") <*>
		(v .:: "resultName") <*>
		(v .:: "resultSource") <*>
		(v .:: "resultDescription") <*>
		(v .:: "resultSignature") <*>
		(v .:: "resultModules") <*>
		(v .:: "resultScore") <*>
		(v .:: "resultType")

instance FromJSON HayooValue where
	parseJSON v = HayooValue <$> ((Right <$> parseJSON v) <|> pure (Left v))

-- | 'HayooFunction' as 'Symbol'
hayooAsSymbol :: HayooSymbol -> Maybe Symbol
hayooAsSymbol f
	| hayooType f `elem` ["function", "type", "newtype", "data", "class"] = Just Symbol {
		_symbolId = SymbolId {
			_symbolName = fromString $ hayooName f,
			_symbolModule = ModuleId {
				_moduleName = fromString $ head $ hayooModules f,
				_moduleLocation = OtherLocation (fromString $ resultUri f) } },
		_symbolDocs = Just (fromString $ addOnline $ untagDescription $ hayooDescription f),
		_symbolPosition = Nothing,
		_symbolInfo = info }
	| otherwise = Nothing
	where
		-- Add other info
		addOnline d = unlines [
			d, "",
			"Hayoo online documentation",
			"",
			"Package: " ++ hayooPackage f,
			"Hackage URL: " ++ resultUri f]

		info
			| hayooType f == "function" = Function (Just $ fromString $ hayooSignature f)
			| hayooType f `elem` ["type", "newtype", "data", "class"] = (fromJust $ lookup (hayooType f) ctors) [] []
			| otherwise = error "Impossible"
		ctors = [("type", Type), ("newtype", NewType), ("data", Data), ("class", Class)]

-- | Search hayoo
hayoo :: Manager -> String -> Maybe Int -> ExceptT String IO HayooResult
hayoo m q page = do
	resp <- liftIO $ do
		req <- parseRequest $ maybe id addPage page $ "http://hayoo.fh-wedel.de/json/?query=" ++ escapeURIString isUnescapedInURIComponent q
		resp <- httpLbs req m
		return $ responseBody resp
	ExceptT $ return $ eitherDecode resp
	where
		addPage :: Int -> String -> String
		addPage p s = s ++ "&page=" ++ show p

-- | Remove tags in description
untagDescription :: String -> String
untagDescription = replaceRx "</?\\w+[^>]*>" ""