packages feed

bamboo-2009.5.23: src/Bamboo/Model/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
import Data.List (sort)
import qualified Data.ByteString.Lazy.Char8 as L


data Tag = Tag 
  { uid :: String     -- tag/name
  , name :: String
  , resources :: S.Set L.ByteString
  }
  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

etag_tag_list xs = xs.mapM (uid > etag_data) ^ sort ^ L.intercalate (pack ",")

get_name id      = id.split "/" .tail.join'
get_resources id = id.id_to_path.read_bytestring

get_resources_set id = id.cache etag_data get_resources ^ L.lines ^ map (bs_slash $ G.post_id.pack ) ^ to_set

bs_slash x y = L.concat [x, "/".pack, y.L.dropWhile (is '/')]

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.u2bs)) .map name
fill_tag xs x     = x { Post.tags = for_resource xs (x.Post.uid) }

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