mirror of
https://github.com/aelve/guide.git
synced 2024-12-25 13:51:45 +03:00
Add the search endpoint to the API
This commit is contained in:
parent
cfd72f436c
commit
a1058bcd2f
@ -183,6 +183,7 @@ library
|
|||||||
, DeriveFunctor
|
, DeriveFunctor
|
||||||
, DeriveTraversable
|
, DeriveTraversable
|
||||||
, DeriveGeneric
|
, DeriveGeneric
|
||||||
|
, TypeApplications
|
||||||
, NoImplicitPrelude
|
, NoImplicitPrelude
|
||||||
|
|
||||||
test-suite tests
|
test-suite tests
|
||||||
|
@ -16,8 +16,8 @@ import Data.Text (Text)
|
|||||||
import Guide.Types
|
import Guide.Types
|
||||||
import Guide.State
|
import Guide.State
|
||||||
import Guide.Utils
|
import Guide.Utils
|
||||||
import Guide.Api.Types (CCategoryInfo, CCategoryDetail, toCategoryInfo, toCCategoryDetail)
|
import Guide.Api.Types
|
||||||
|
import qualified Guide.Search as Search
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- Categories
|
-- Categories
|
||||||
@ -27,14 +27,14 @@ import Guide.Api.Types (CCategoryInfo, CCategoryDetail, toCategoryInfo, toCCateg
|
|||||||
getCategories :: DB -> Handler [CCategoryInfo]
|
getCategories :: DB -> Handler [CCategoryInfo]
|
||||||
getCategories db = do
|
getCategories db = do
|
||||||
dbQuery db GetCategories <&> \xs ->
|
dbQuery db GetCategories <&> \xs ->
|
||||||
map toCategoryInfo xs
|
map toCCategoryInfo xs
|
||||||
|
|
||||||
-- | Get a single category and all of its items.
|
-- | Get a single category and all of its items.
|
||||||
getCategory :: DB -> Uid Category -> Handler CCategoryDetail
|
getCategory :: DB -> Uid Category -> Handler CCategoryFull
|
||||||
getCategory db catId =
|
getCategory db catId =
|
||||||
dbQuery db (GetCategoryMaybe catId) >>= \case
|
dbQuery db (GetCategoryMaybe catId) >>= \case
|
||||||
Nothing -> throwError err404
|
Nothing -> throwError err404
|
||||||
Just cat -> pure (toCCategoryDetail cat)
|
Just cat -> pure (toCCategoryFull cat)
|
||||||
|
|
||||||
-- | Create a new category, given the title.
|
-- | Create a new category, given the title.
|
||||||
--
|
--
|
||||||
@ -106,6 +106,18 @@ deleteTrait db itemId traitId = do
|
|||||||
pure NoContent
|
pure NoContent
|
||||||
-- TODO: mapM_ addEdit mbEdit
|
-- TODO: mapM_ addEdit mbEdit
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
-- Search
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Site-wide search.
|
||||||
|
--
|
||||||
|
-- Returns at most 100 results.
|
||||||
|
search :: DB -> Text -> Handler [CSearchResult]
|
||||||
|
search db searchQuery = do
|
||||||
|
gs <- dbQuery db GetGlobalState
|
||||||
|
pure $ map toCSearchResult $ take 100 $ Search.search searchQuery gs
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- Utils
|
-- Utils
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
|
@ -49,6 +49,10 @@ apiServer db = Site
|
|||||||
, _traitSite = toServant (TraitSite
|
, _traitSite = toServant (TraitSite
|
||||||
{ _deleteTrait = deleteTrait db }
|
{ _deleteTrait = deleteTrait db }
|
||||||
:: TraitSite AsServer)
|
:: TraitSite AsServer)
|
||||||
|
|
||||||
|
, _searchSite = toServant (SearchSite
|
||||||
|
{ _search = search db }
|
||||||
|
:: SearchSite AsServer)
|
||||||
}
|
}
|
||||||
|
|
||||||
type FullApi =
|
type FullApi =
|
||||||
|
@ -18,15 +18,18 @@ module Guide.Api.Types
|
|||||||
, CategorySite(..)
|
, CategorySite(..)
|
||||||
, ItemSite(..)
|
, ItemSite(..)
|
||||||
, TraitSite(..)
|
, TraitSite(..)
|
||||||
|
, SearchSite(..)
|
||||||
|
|
||||||
-- * View types
|
-- * View types
|
||||||
, CCategoryInfo(..)
|
, CCategoryInfo(..), toCCategoryInfo
|
||||||
, CCategoryDetail(..)
|
, CCategoryFull(..), toCCategoryFull
|
||||||
, CItem(..)
|
, CItemInfo(..), toCItemInfo
|
||||||
, CMarkdown(..)
|
, CItemFull(..), toCItemFull
|
||||||
, CTrait(..)
|
, CMarkdown(..), toCMarkdown
|
||||||
, toCCategoryDetail
|
, CTrait(..), toCTrait
|
||||||
, toCategoryInfo
|
|
||||||
|
-- * Search
|
||||||
|
, CSearchResult(..), toCSearchResult
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -41,9 +44,8 @@ import Data.Swagger as S
|
|||||||
|
|
||||||
import Guide.Api.Error
|
import Guide.Api.Error
|
||||||
import Guide.Api.Utils
|
import Guide.Api.Utils
|
||||||
import Guide.Types.Core
|
import Guide.Types.Core as G
|
||||||
( Category(..), CategoryStatus(..), Item(..), ItemKind
|
import Guide.Search
|
||||||
, Trait, content, uid )
|
|
||||||
import Guide.Utils (Uid(..), Url)
|
import Guide.Utils (Uid(..), Url)
|
||||||
import Guide.Markdown (MarkdownBlock, MarkdownInline, MarkdownTree, mdHtml, mdSource)
|
import Guide.Markdown (MarkdownBlock, MarkdownInline, MarkdownTree, mdHtml, mdSource)
|
||||||
|
|
||||||
@ -62,9 +64,13 @@ data Site route = Site
|
|||||||
, _traitSite :: route :-
|
, _traitSite :: route :-
|
||||||
BranchTag "03. Item traits" "Working with item traits."
|
BranchTag "03. Item traits" "Working with item traits."
|
||||||
:> ToServant TraitSite AsApi
|
:> ToServant TraitSite AsApi
|
||||||
|
, _searchSite :: route :-
|
||||||
|
BranchTag "04. Search" "Site-wide search."
|
||||||
|
:> ToServant SearchSite AsApi
|
||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
-- | Working with categories
|
||||||
data CategorySite route = CategorySite
|
data CategorySite route = CategorySite
|
||||||
{ _getCategories :: route :-
|
{ _getCategories :: route :-
|
||||||
Summary "Get a list of available categories"
|
Summary "Get a list of available categories"
|
||||||
@ -79,7 +85,7 @@ data CategorySite route = CategorySite
|
|||||||
:> ErrorResponse 404 "Category not found"
|
:> ErrorResponse 404 "Category not found"
|
||||||
:> "category"
|
:> "category"
|
||||||
:> Capture "id" (Uid Category)
|
:> Capture "id" (Uid Category)
|
||||||
:> Get '[JSON] CCategoryDetail
|
:> Get '[JSON] CCategoryFull
|
||||||
|
|
||||||
, _createCategory :: route :-
|
, _createCategory :: route :-
|
||||||
Summary "Create a new category"
|
Summary "Create a new category"
|
||||||
@ -100,6 +106,7 @@ data CategorySite route = CategorySite
|
|||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
-- | Working with items
|
||||||
data ItemSite route = ItemSite
|
data ItemSite route = ItemSite
|
||||||
{ _createItem :: route :-
|
{ _createItem :: route :-
|
||||||
Summary "Create a new item in the given category"
|
Summary "Create a new item in the given category"
|
||||||
@ -119,6 +126,7 @@ data ItemSite route = ItemSite
|
|||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
-- | Working with item traits
|
||||||
data TraitSite route = TraitSite
|
data TraitSite route = TraitSite
|
||||||
{ _deleteTrait :: route :-
|
{ _deleteTrait :: route :-
|
||||||
Summary "Delete a trait"
|
Summary "Delete a trait"
|
||||||
@ -132,19 +140,31 @@ data TraitSite route = TraitSite
|
|||||||
}
|
}
|
||||||
deriving (Generic)
|
deriving (Generic)
|
||||||
|
|
||||||
|
-- | Site-wide search
|
||||||
|
data SearchSite route = SearchSite
|
||||||
|
{ _search :: route :-
|
||||||
|
Summary "Search categories and items"
|
||||||
|
:> Description "Returns at most 100 search results"
|
||||||
|
:> "search"
|
||||||
|
:> QueryParam' '[Required, Strict] "query" Text
|
||||||
|
:> Get '[JSON] [CSearchResult]
|
||||||
|
}
|
||||||
|
deriving (Generic)
|
||||||
|
|
||||||
type Api = ToServant Site AsApi
|
type Api = ToServant Site AsApi
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- Client types
|
-- Client types
|
||||||
--
|
--
|
||||||
-- These are more "light-weight" Haskell types of `Guide`.
|
-- These are more "light-weight" Haskell types of 'Guide'.
|
||||||
--
|
--
|
||||||
-- Furthermore using these "light-weight" types we keep all data small
|
-- Furthermore using these "light-weight" types we keep all data small
|
||||||
-- to send these over the wire w/o having deep nested data,
|
-- to send these over the wire w/o having deep nested data,
|
||||||
-- we might not need on front-end.
|
-- we might not need on front-end.
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
-- | A "light-weight" client type of `Category`, which describes a category info
|
-- | A "light-weight" client type of 'Category', which describes a category
|
||||||
|
-- but doesn't give the notes or the items.
|
||||||
data CCategoryInfo = CCategoryInfo
|
data CCategoryInfo = CCategoryInfo
|
||||||
{ cciUid :: Uid Category ? "Category ID"
|
{ cciUid :: Uid Category ? "Category ID"
|
||||||
, cciTitle :: Text ? "Category title"
|
, cciTitle :: Text ? "Category title"
|
||||||
@ -160,9 +180,9 @@ instance A.ToJSON CCategoryInfo where
|
|||||||
instance ToSchema CCategoryInfo where
|
instance ToSchema CCategoryInfo where
|
||||||
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
-- | Factory to create a `CCategoryInfo` from a `Category`
|
-- | Factory to create a 'CCategoryInfo' from a 'Category'
|
||||||
toCategoryInfo :: Category -> CCategoryInfo
|
toCCategoryInfo :: Category -> CCategoryInfo
|
||||||
toCategoryInfo Category{..} = CCategoryInfo
|
toCCategoryInfo Category{..} = CCategoryInfo
|
||||||
{ cciUid = H _categoryUid
|
{ cciUid = H _categoryUid
|
||||||
, cciTitle = H _categoryTitle
|
, cciTitle = H _categoryTitle
|
||||||
, cciCreated = H _categoryCreated
|
, cciCreated = H _categoryCreated
|
||||||
@ -170,72 +190,100 @@ toCategoryInfo Category{..} = CCategoryInfo
|
|||||||
, cciStatus = H _categoryStatus
|
, cciStatus = H _categoryStatus
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | A "light-weight" client type of `Category`, which describes a category detail
|
-- | A "light-weight" client type of 'Category', which gives all available
|
||||||
data CCategoryDetail = CCategoryDetail
|
-- information about a category
|
||||||
{ ccdUid :: Uid Category ? "Category ID"
|
data CCategoryFull = CCategoryFull
|
||||||
, ccdTitle :: Text ? "Category title"
|
{ ccfUid :: Uid Category ? "Category ID"
|
||||||
, ccdGroup :: Text ? "Category group ('grandcategory')"
|
, ccfTitle :: Text ? "Category title"
|
||||||
, ccdStatus :: CategoryStatus ? "Status, e.g. done, in progress, ..."
|
, ccfGroup :: Text ? "Category group ('grandcategory')"
|
||||||
, ccdDescription :: CMarkdown ? "Category description/notes (Markdown)"
|
, ccfStatus :: CategoryStatus ? "Status, e.g. done, in progress, ..."
|
||||||
, ccdItems :: [CItem] ? "All items in the category"
|
, ccfDescription :: CMarkdown ? "Category description/notes (Markdown)"
|
||||||
|
, ccfItems :: [CItemFull] ? "All items in the category"
|
||||||
}
|
}
|
||||||
deriving (Show, Generic)
|
deriving (Show, Generic)
|
||||||
|
|
||||||
instance A.ToJSON CCategoryDetail where
|
instance A.ToJSON CCategoryFull where
|
||||||
toJSON = A.genericToJSON jsonOptions
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
instance ToSchema CCategoryDetail where
|
instance ToSchema CCategoryFull where
|
||||||
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
-- | Factory to create a `CCategoryDetail` from a `Category`
|
-- | Factory to create a 'CCategoryFull' from a 'Category'
|
||||||
toCCategoryDetail :: Category -> CCategoryDetail
|
toCCategoryFull :: Category -> CCategoryFull
|
||||||
toCCategoryDetail Category{..} = CCategoryDetail
|
toCCategoryFull Category{..} = CCategoryFull
|
||||||
{ ccdUid = H $ _categoryUid
|
{ ccfUid = H $ _categoryUid
|
||||||
, ccdTitle = H $ _categoryTitle
|
, ccfTitle = H $ _categoryTitle
|
||||||
, ccdGroup = H $ _categoryGroup_
|
, ccfGroup = H $ _categoryGroup_
|
||||||
, ccdDescription = H $ toCMarkdown _categoryNotes
|
, ccfDescription = H $ toCMarkdown _categoryNotes
|
||||||
, ccdItems = H $ fmap toCItem _categoryItems
|
, ccfItems = H $ fmap toCItemFull _categoryItems
|
||||||
, ccdStatus = H $ _categoryStatus
|
, ccfStatus = H $ _categoryStatus
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Client type of `Item`
|
-- | A lightweight info type about an 'Item'
|
||||||
data CItem = CItem
|
data CItemInfo = CItemInfo
|
||||||
{ ciUid :: Uid Item ? "Item ID"
|
{ ciiUid :: Uid Item ? "Item ID"
|
||||||
, ciName :: Text ? "Item name"
|
, ciiName :: Text ? "Item name"
|
||||||
, ciCreated :: UTCTime ? "When the item was created"
|
, ciiCreated :: UTCTime ? "When the item was created"
|
||||||
, ciGroup :: Maybe Text ? "Item group"
|
, ciiGroup :: Maybe Text ? "Item group"
|
||||||
, ciDescription :: CMarkdown ? "Item summary (Markdown)"
|
, ciiLink :: Maybe Url ? "Link to the official site, if exists"
|
||||||
, ciPros :: [CTrait] ? "Pros (positive traits)"
|
, ciiKind :: ItemKind ? "Item kind, e.g. library, ..."
|
||||||
, ciCons :: [CTrait] ? "Cons (negative traits)"
|
|
||||||
, ciEcosystem :: CMarkdown ? "The ecosystem description (Markdown)"
|
|
||||||
, ciNotes :: CMarkdown ? "Notes (Markdown)"
|
|
||||||
, ciLink :: Maybe Url ? "Link to the official site, if exists"
|
|
||||||
, ciKind :: ItemKind ? "Item kind, e.g. library, ..."
|
|
||||||
} deriving (Show, Generic)
|
} deriving (Show, Generic)
|
||||||
|
|
||||||
instance A.ToJSON CItem where
|
instance A.ToJSON CItemInfo where
|
||||||
toJSON = A.genericToJSON jsonOptions
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
instance ToSchema CItem where
|
instance ToSchema CItemInfo where
|
||||||
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
-- | Factory to create a `CItem` from an `Item`
|
-- | Client type of 'Item'
|
||||||
toCItem :: Item -> CItem
|
data CItemFull = CItemFull
|
||||||
toCItem Item{..} = CItem
|
{ cifUid :: Uid Item ? "Item ID"
|
||||||
{ ciUid = H $ _itemUid
|
, cifName :: Text ? "Item name"
|
||||||
, ciName = H $ _itemName
|
, cifCreated :: UTCTime ? "When the item was created"
|
||||||
, ciCreated = H $ _itemCreated
|
, cifGroup :: Maybe Text ? "Item group"
|
||||||
, ciGroup = H $ _itemGroup_
|
, cifDescription :: CMarkdown ? "Item summary (Markdown)"
|
||||||
, ciDescription = H $ toCMarkdown _itemDescription
|
, cifPros :: [CTrait] ? "Pros (positive traits)"
|
||||||
, ciPros = H $ fmap toCTrait _itemPros
|
, cifCons :: [CTrait] ? "Cons (negative traits)"
|
||||||
, ciCons = H $ fmap toCTrait _itemCons
|
, cifEcosystem :: CMarkdown ? "The ecosystem description (Markdown)"
|
||||||
, ciEcosystem = H $ toCMarkdown _itemEcosystem
|
, cifNotes :: CMarkdown ? "Notes (Markdown)"
|
||||||
, ciNotes = H $ toCMarkdown _itemNotes
|
, cifLink :: Maybe Url ? "Link to the official site, if exists"
|
||||||
, ciLink = H $ _itemLink
|
, cifKind :: ItemKind ? "Item kind, e.g. library, ..."
|
||||||
, ciKind = H $ _itemKind
|
} deriving (Show, Generic)
|
||||||
|
|
||||||
|
instance A.ToJSON CItemFull where
|
||||||
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
|
instance ToSchema CItemFull where
|
||||||
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
|
-- | Factory to create a 'CItemInfo' from an 'Item'
|
||||||
|
toCItemInfo :: Item -> CItemInfo
|
||||||
|
toCItemInfo Item{..} = CItemInfo
|
||||||
|
{ ciiUid = H $ _itemUid
|
||||||
|
, ciiName = H $ _itemName
|
||||||
|
, ciiCreated = H $ _itemCreated
|
||||||
|
, ciiGroup = H $ _itemGroup_
|
||||||
|
, ciiLink = H $ _itemLink
|
||||||
|
, ciiKind = H $ _itemKind
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Client type of `Trait`
|
-- | Factory to create a 'CItemFull' from an 'Item'
|
||||||
|
toCItemFull :: Item -> CItemFull
|
||||||
|
toCItemFull Item{..} = CItemFull
|
||||||
|
{ cifUid = H $ _itemUid
|
||||||
|
, cifName = H $ _itemName
|
||||||
|
, cifCreated = H $ _itemCreated
|
||||||
|
, cifGroup = H $ _itemGroup_
|
||||||
|
, cifDescription = H $ toCMarkdown _itemDescription
|
||||||
|
, cifPros = H $ fmap toCTrait _itemPros
|
||||||
|
, cifCons = H $ fmap toCTrait _itemCons
|
||||||
|
, cifEcosystem = H $ toCMarkdown _itemEcosystem
|
||||||
|
, cifNotes = H $ toCMarkdown _itemNotes
|
||||||
|
, cifLink = H $ _itemLink
|
||||||
|
, cifKind = H $ _itemKind
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Client type of 'Trait'
|
||||||
data CTrait = CTrait
|
data CTrait = CTrait
|
||||||
{ ctUid :: Uid Trait ? "Trait ID"
|
{ ctUid :: Uid Trait ? "Trait ID"
|
||||||
, ctContent :: CMarkdown ? "Trait text (Markdown)"
|
, ctContent :: CMarkdown ? "Trait text (Markdown)"
|
||||||
@ -247,14 +295,14 @@ instance A.ToJSON CTrait where
|
|||||||
instance ToSchema CTrait where
|
instance ToSchema CTrait where
|
||||||
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
-- | Factory to create a `CTrait` from a `Trait`
|
-- | Factory to create a 'CTrait' from a 'Trait'
|
||||||
toCTrait :: Trait -> CTrait
|
toCTrait :: Trait -> CTrait
|
||||||
toCTrait trait = CTrait
|
toCTrait trait = CTrait
|
||||||
{ ctUid = H $ trait ^. uid
|
{ ctUid = H $ trait ^. uid
|
||||||
, ctContent = H $ toCMarkdown $ trait ^. content
|
, ctContent = H $ toCMarkdown $ trait ^. content
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Client type of `Markdown`
|
-- | Client type of 'Markdown'
|
||||||
data CMarkdown = CMarkdown
|
data CMarkdown = CMarkdown
|
||||||
{ text :: Text ? "Markdown source"
|
{ text :: Text ? "Markdown source"
|
||||||
, html :: Text ? "Rendered HTML"
|
, html :: Text ? "Rendered HTML"
|
||||||
@ -263,27 +311,94 @@ data CMarkdown = CMarkdown
|
|||||||
instance A.ToJSON CMarkdown
|
instance A.ToJSON CMarkdown
|
||||||
instance ToSchema CMarkdown
|
instance ToSchema CMarkdown
|
||||||
|
|
||||||
-- | Type class to create `CMarkdown`
|
-- | Type class to create 'CMarkdown'
|
||||||
class ToCMardown md where toCMarkdown :: md -> CMarkdown
|
class ToCMarkdown md where toCMarkdown :: md -> CMarkdown
|
||||||
|
|
||||||
instance ToCMardown MarkdownInline where
|
instance ToCMarkdown MarkdownInline where
|
||||||
toCMarkdown md = CMarkdown
|
toCMarkdown md = CMarkdown
|
||||||
{ text = H $ md^.mdSource
|
{ text = H $ md^.mdSource
|
||||||
, html = H $ toText $ md^.mdHtml
|
, html = H $ toText $ md^.mdHtml
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ToCMardown MarkdownBlock where
|
instance ToCMarkdown MarkdownBlock where
|
||||||
toCMarkdown md = CMarkdown
|
toCMarkdown md = CMarkdown
|
||||||
{ text = H $ md^.mdSource
|
{ text = H $ md^.mdSource
|
||||||
, html = H $ toText $ md^.mdHtml
|
, html = H $ toText $ md^.mdHtml
|
||||||
}
|
}
|
||||||
|
|
||||||
instance ToCMardown MarkdownTree where
|
instance ToCMarkdown MarkdownTree where
|
||||||
toCMarkdown md = CMarkdown
|
toCMarkdown md = CMarkdown
|
||||||
{ text = H $ md^.mdSource
|
{ text = H $ md^.mdSource
|
||||||
, html = H $ toText . renderText $ toHtml md
|
, html = H $ toText . renderText $ toHtml md
|
||||||
}
|
}
|
||||||
|
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
-- Search client types
|
||||||
|
----------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | Client type of 'SearchResult'
|
||||||
|
data CSearchResult
|
||||||
|
-- | Match was found in category title
|
||||||
|
= CSRCategoryResult CSRCategory
|
||||||
|
-- | Match was found in the item
|
||||||
|
| CSRItemResult CSRItem
|
||||||
|
deriving (Show, Generic)
|
||||||
|
|
||||||
|
instance A.ToJSON CSearchResult where
|
||||||
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
|
instance ToSchema CSearchResult where
|
||||||
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
|
-- | A category was found.
|
||||||
|
data CSRCategory = CSRCategory
|
||||||
|
{ csrcInfo :: CCategoryInfo ? "Info about the category"
|
||||||
|
, csrcDescription :: CMarkdown ? "Category description"
|
||||||
|
} deriving (Show, Generic)
|
||||||
|
|
||||||
|
instance A.ToJSON CSRCategory where
|
||||||
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
|
instance ToSchema CSRCategory where
|
||||||
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
|
-- | An item was found.
|
||||||
|
data CSRItem = CSRItem
|
||||||
|
{ csriCategory :: CCategoryInfo ? "Category that the item belongs to"
|
||||||
|
, csriInfo :: CItemInfo ? "Info about the item"
|
||||||
|
, csriDescription :: Maybe CMarkdown ? "Item description (if the match was found there)"
|
||||||
|
, csriEcosystem :: Maybe CMarkdown ? "Item ecosystem (if the match was found there)"
|
||||||
|
} deriving (Show, Generic)
|
||||||
|
|
||||||
|
instance A.ToJSON CSRItem where
|
||||||
|
toJSON = A.genericToJSON jsonOptions
|
||||||
|
|
||||||
|
instance ToSchema CSRItem where
|
||||||
|
declareNamedSchema = genericDeclareNamedSchema schemaOptions
|
||||||
|
|
||||||
|
toCSearchResult :: SearchResult -> CSearchResult
|
||||||
|
toCSearchResult (SRCategory cat) =
|
||||||
|
CSRCategoryResult $ CSRCategory
|
||||||
|
{ csrcInfo = H $ toCCategoryInfo cat
|
||||||
|
, csrcDescription = H $ toCMarkdown (cat ^. G.notes)
|
||||||
|
}
|
||||||
|
toCSearchResult (SRItem cat item) =
|
||||||
|
CSRItemResult $ CSRItem
|
||||||
|
{ csriCategory = H $ toCCategoryInfo cat
|
||||||
|
, csriInfo = H $ toCItemInfo item
|
||||||
|
, csriDescription = H $ Just (toCMarkdown (item ^. G.description))
|
||||||
|
, csriEcosystem = H $ Nothing
|
||||||
|
}
|
||||||
|
-- TODO: currently if there are matches in both description and category,
|
||||||
|
-- we'll show two matches instead of one
|
||||||
|
toCSearchResult (SRItemEcosystem cat item) =
|
||||||
|
CSRItemResult $ CSRItem
|
||||||
|
{ csriCategory = H $ toCCategoryInfo cat
|
||||||
|
, csriInfo = H $ toCItemInfo item
|
||||||
|
, csriDescription = H $ Nothing
|
||||||
|
, csriEcosystem = H $ Just (toCMarkdown (item ^. ecosystem))
|
||||||
|
}
|
||||||
|
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- Schema instances
|
-- Schema instances
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
|
Loading…
Reference in New Issue
Block a user