-- | Functions and data types to handle Hoogle results

module Docs.CLI.Hoogle where

import Prelude hiding (mod)
import Data.Maybe (fromMaybe)
import Data.Aeson (FromJSON(..))

import Docs.CLI.Types
import Docs.CLI.Haddock (Html, parseHoogleHtml, HasCompletion(..), innerString)
import qualified Hoogle

data Item
  = Declaration Declaration
  | Module Module
  | Package Package
  deriving (Item -> Item -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq)

instance HasCompletion Item where
  completion :: Item -> String
completion = \case
   Declaration Declaration
d -> Declaration -> String
dCompletion Declaration
d
   Module Module
m      -> Module -> String
mTitle Module
m
   Package Package
p     -> Package -> String
pTitle Package
p

instance FromJSON Item where
  parseJSON :: Value -> Parser Item
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Target -> Item
fromHoogleTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
parseJSON

fromHoogleTarget :: Hoogle.Target -> Item
fromHoogleTarget :: Target -> Item
fromHoogleTarget Target
target =
  case Target -> String
Hoogle.targetType Target
target of
    String
"module" ->
      let
          (String
pkg, String
pkgUrl) = forall a. a -> Maybe a -> a
fromMaybe
            (forall a. HasCallStack => String -> a
error String
"Hoogle module without package info")
            (Target -> Maybe (String, String)
Hoogle.targetPackage Target
target)

          desc :: Html
desc = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetItem Target
target
      in
      Module -> Item
Module forall a b. (a -> b) -> a -> b
$ Module_
        { mUrl :: ModuleUrl
mUrl         = String -> ModuleUrl
ModuleUrl forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetURL Target
target
        , mPackageUrl :: PackageUrl
mPackageUrl  = String -> PackageUrl
PackageUrl String
pkgUrl
        , mPackage :: String
mPackage     = String
pkg
        , mDescription :: Html
mDescription = Html
desc
        , mDocs :: Html
mDocs        = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetDocs Target
target
        , mTarget :: Target
mTarget      = Target
target
        , mTitle :: String
mTitle       = Html -> String
innerString Html
desc
        }
    String
"package" ->
      let desc :: Html
desc = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetItem Target
target
      in
      Package -> Item
Package forall a b. (a -> b) -> a -> b
$ Package_
        { pUrl :: PackageUrl
pUrl         = String -> PackageUrl
PackageUrl forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetURL Target
target
        , pDescription :: Html
pDescription = Html
desc
        , pDocs :: Html
pDocs        = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetDocs Target
target
        , pTarget :: Target
pTarget      = Target
target
        , pTitle :: String
pTitle       = Html -> String
innerString Html
desc
        }
    String
_ ->
      let
          (String
pkg, String
pkgUrl) = forall a. a -> Maybe a -> a
fromMaybe
            (forall a. HasCallStack => String -> a
error String
"Hoogle declaration without package info")
            (Target -> Maybe (String, String)
Hoogle.targetPackage Target
target)

          (String
mod, String
modUrl) = forall a. a -> Maybe a -> a
fromMaybe
            (forall a. HasCallStack => String -> a
error String
"Hoogle declaration without module info")
            (Target -> Maybe (String, String)
Hoogle.targetModule Target
target)

          anchor :: Anchor
anchor = forall a. a -> Maybe a -> a
fromMaybe
            (forall a. HasCallStack => String -> a
error String
"Hoogle declaration without anchor in Link URL")
            (forall (m :: * -> *). MonadFail m => String -> m Anchor
takeAnchor forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetURL Target
target)

          moduleUrl :: ModuleUrl
moduleUrl = String -> ModuleUrl
ModuleUrl String
modUrl
          desc :: Html
desc = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetItem Target
target
      in
      Declaration -> Item
Declaration forall a b. (a -> b) -> a -> b
$ Declaration_
        { dUrl :: DeclUrl
dUrl         = ModuleUrl -> Anchor -> DeclUrl
DeclUrl ModuleUrl
moduleUrl Anchor
anchor
        , dPackage :: String
dPackage     = String
pkg
        , dPackageUrl :: PackageUrl
dPackageUrl  = String -> PackageUrl
PackageUrl String
pkgUrl
        , dModule :: String
dModule      = String
mod
        , dModuleUrl :: ModuleUrl
dModuleUrl   = ModuleUrl
moduleUrl
        , dDescription :: Html
dDescription = Html
desc
        , dDocs :: Html
dDocs        = String -> Html
parseHoogleHtml forall a b. (a -> b) -> a -> b
$ Target -> String
Hoogle.targetDocs Target
target
        , dCompletion :: String
dCompletion  = Html -> String
innerString Html
desc
        , dTarget :: Target
dTarget      = Target
target
        }

data Declaration = Declaration_
  { Declaration -> DeclUrl
dUrl         :: DeclUrl
  , Declaration -> String
dPackage     :: String
  , Declaration -> PackageUrl
dPackageUrl  :: PackageUrl
  , Declaration -> String
dModule      :: String
  , Declaration -> ModuleUrl
dModuleUrl   :: ModuleUrl
  , Declaration -> Html
dDescription :: Html
  , Declaration -> Html
dDocs        :: Html
  , Declaration -> Target
dTarget      :: Hoogle.Target
  , Declaration -> String
dCompletion  :: String
  }
  deriving (Declaration -> Declaration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Declaration -> Declaration -> Bool
$c/= :: Declaration -> Declaration -> Bool
== :: Declaration -> Declaration -> Bool
$c== :: Declaration -> Declaration -> Bool
Eq)

data Module = Module_
  { Module -> ModuleUrl
mUrl         :: ModuleUrl
  , Module -> String
mPackage     :: String
  , Module -> PackageUrl
mPackageUrl  :: PackageUrl
  , Module -> Html
mDescription :: Html
  , Module -> Html
mDocs        :: Html
  , Module -> Target
mTarget      :: Hoogle.Target
  , Module -> String
mTitle       :: String
  }
  deriving (Module -> Module -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Module -> Module -> Bool
$c/= :: Module -> Module -> Bool
== :: Module -> Module -> Bool
$c== :: Module -> Module -> Bool
Eq)

data Package = Package_
  { Package -> PackageUrl
pUrl         :: PackageUrl
  , Package -> Html
pDescription :: Html
  , Package -> Html
pDocs        :: Html
  , Package -> Target
pTarget      :: Hoogle.Target
  , Package -> String
pTitle       :: String
  }
  deriving (Package -> Package -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Package -> Package -> Bool
$c/= :: Package -> Package -> Bool
== :: Package -> Package -> Bool
$c== :: Package -> Package -> Bool
Eq)

description :: Item -> Html
description :: Item -> Html
description = \case
  Declaration Declaration
d -> Declaration -> Html
dDescription Declaration
d
  Module      Module
m -> Module -> Html
mDescription Module
m
  Package     Package
p -> Package -> Html
pDescription Package
p

docs :: Item -> Html
docs :: Item -> Html
docs = \case
  Declaration Declaration
d -> Declaration -> Html
dDocs Declaration
d
  Module      Module
m -> Module -> Html
mDocs Module
m
  Package     Package
p -> Package -> Html
pDocs Package
p