Tag.hs

{-# LANGUAGE NoImplicitPrelude #-}
module Bamboo.Model.Tag where

import qualified Bamboo.Model.Post as Post

-- env
import Bamboo.Helper.Env hiding (name)
import Bamboo.Helper.StateHelper
import qualified Data.Set as S
import qualified Bamboo.Config.Global as G
import Bamboo.Type.Cache


data Tag = Tag 
  { uid :: String     -- tag/name
  , name :: String
  , resources :: S.Set String
  }
  deriving (Show, Eq)

instance Resource Tag where
  resource_title = uid > spaced_url

-- CRUD
instance Gettable Tag where
  get id           = get_resources_set id ^ Tag id (get_name id)

instance Listable Tag where
  list             = ls G.tag_uri ^ map (G.tag_id /) >>= mapM get


get_name id      = id.split "/" .tail.join'
get_resources id = id.id_to_path.read_file ^ filter_comment

get_resources_set id = id.cache etag_data get_resources ^ lines ^ map (G.post_id / ) ^ to_set

resource_title_from_name x = ("tag" / x) .spaced_url
tag_map' xs       = xs . map (name &&& resources) . to_h
tag_map           = list ^ tag_map'

for_resource xs x = xs.select (resources > has x) .map name
fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }

-- extra
sorted xs    = xs.sortBy(compare_by (resources > S.size)).reverse
name_to_id x = G.tag_id / x