{-# LANGUAGE UndecidableInstances #-}

module Conduit.Features.Articles.Tags.GetTags where

import Prelude hiding (get, on)
import Conduit.App.Monad (AppM, runService)
import Conduit.DB.Core (MonadDB(..), mapDBResult)
import Conduit.Features.Articles.DB (Article(..))
import Conduit.Features.Articles.Errors (ArticleError(..))
import Conduit.Features.Articles.Types (inTagsObj)
import Data.List (nub)
import Database.Esqueleto.Experimental (Value(..), distinct, from, select, table)
import UnliftIO (MonadUnliftIO)
import Web.Scotty.Trans (ScottyT, get, json)

-- I genuinely don't understand what this endpoint is really supposed to do, as the realworld
-- api spec is annoyingly vague. I tried just returning all unique tags from the DB, but there
-- are 18 unique tags when running the cypress test, but the test expects anywhere from [1..10]??
handleGetTags :: ScottyT AppM ()
handleGetTags :: ScottyT AppM ()
handleGetTags = RoutePattern -> ActionT AppM () -> ScottyT AppM ()
forall (m :: * -> *).
MonadUnliftIO m =>
RoutePattern -> ActionT m () -> ScottyT m ()
get RoutePattern
"/api/tags" do
  [Text]
article <- AppM (Either ArticleError [Text]) -> ActionT AppM [Text]
forall e a. FeatureError e => AppM (Either e a) -> ActionT AppM a
runService AppM (Either ArticleError [Text])
forall (m :: * -> *).
AquireTags m =>
m (Either ArticleError [Text])
getAllTags
  InObj [Text] -> ActionT AppM ()
forall a (m :: * -> *). (ToJSON a, MonadIO m) => a -> ActionT m ()
json (InObj [Text] -> ActionT AppM ())
-> InObj [Text] -> ActionT AppM ()
forall a b. (a -> b) -> a -> b
$ [Text] -> InObj [Text]
forall obj. obj -> InObj obj
inTagsObj [Text]
article

class (Monad m) => AquireTags m where
  getAllTags :: m (Either ArticleError [Text])

instance (Monad m, MonadDB m, MonadUnliftIO m) => AquireTags m where
  getAllTags :: m (Either ArticleError [Text])
  getAllTags :: m (Either ArticleError [Text])
getAllTags = ([Value [Text]] -> [Text])
-> Either DBError [Value [Text]] -> Either ArticleError [Text]
forall e a b.
FeatureError e =>
(a -> b) -> Either DBError a -> Either e b
mapDBResult [Value [Text]] -> [Text]
toTags (Either DBError [Value [Text]] -> Either ArticleError [Text])
-> m (Either DBError [Value [Text]])
-> m (Either ArticleError [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SqlPersistT m [Value [Text]] -> m (Either DBError [Value [Text]])
forall a. SqlPersistT m a -> m (Either DBError a)
forall (m :: * -> *) a.
MonadDB m =>
SqlPersistT m a -> m (Either DBError a)
runDB do
    SqlQuery (SqlExpr (Value [Text])) -> SqlPersistT m [Value [Text]]
forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
select (SqlQuery (SqlExpr (Value [Text])) -> SqlPersistT m [Value [Text]])
-> SqlQuery (SqlExpr (Value [Text]))
-> SqlPersistT m [Value [Text]]
forall a b. (a -> b) -> a -> b
$ SqlQuery (SqlExpr (Value [Text]))
-> SqlQuery (SqlExpr (Value [Text]))
forall a. SqlQuery a -> SqlQuery a
distinct do
      SqlExpr (Entity Article)
a <- From (SqlExpr (Entity Article))
-> SqlQuery (SqlExpr (Entity Article))
forall a a'. ToFrom a a' => a -> SqlQuery a'
from (From (SqlExpr (Entity Article))
 -> SqlQuery (SqlExpr (Entity Article)))
-> From (SqlExpr (Entity Article))
-> SqlQuery (SqlExpr (Entity Article))
forall a b. (a -> b) -> a -> b
$ forall ent. PersistEntity ent => From (SqlExpr (Entity ent))
table @Article
      SqlExpr (Value [Text]) -> SqlQuery (SqlExpr (Value [Text]))
forall a. a -> SqlQuery a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SqlExpr (Entity Article)
a.tags

-- todo: swap out with fixed version so I don't need to do nub here
-- select distinct tag from (select json_array_elements_text(tags::json) as tag from article) as tags;

toTags :: [Value [Text]] -> [Text]
toTags :: [Value [Text]] -> [Text]
toTags = Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
10 ([Text] -> [Text])
-> ([Value [Text]] -> [Text]) -> [Value [Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text])
-> ([Value [Text]] -> [Text]) -> [Value [Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Text]] -> [Text])
-> ([Value [Text]] -> [[Text]]) -> [Value [Text]] -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value [Text] -> [Text]) -> [Value [Text]] -> [[Text]]
forall a b. (a -> b) -> [a] -> [b]
map (\(Value [Text]
v) -> [Text]
v)