{-# LANGUAGE NoImplicitPrelude #-} module Bamboo.Model.Tag where import qualified Bamboo.Model.Post as Post import Bamboo.Helper.StateHelper import Bamboo.Model.Env import qualified Bamboo.Model.Post as Post import qualified Bamboo.Model.Post as Post import qualified Bamboo.Type as C import qualified Data.ByteString.Char8 as S import qualified Data.Map as Map import qualified Data.Set as Set data Tag = Tag { uid :: String -- tag/name , name :: String , resources :: Set.Set S.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 (static_config.tag_uri) ^ map (static_config.tag_id /) >>= mapM get get_name :: SC get_name id = id.split "/" .tail.join' get_resources :: String -> IO S.ByteString get_resources id = id.id_to_path.read_bytestring get_resources_set :: String -> IO (Set.Set S.ByteString) get_resources_set id = id .get_resources ^ S.lines ^ map (bs_slash $ static_config.post_id.pack ) ^ to_set bs_slash :: S.ByteString -> S.ByteString -> S.ByteString bs_slash x y = S.concat [x, "/".pack, y.S.dropWhile (is '/')] resource_title_from_name :: SC resource_title_from_name x = (static_config.tag_id / x) .spaced_url tag_map' :: [Tag] -> Map.Map String (Set.Set S.ByteString) tag_map' xs = xs . map (name &&& resources) . to_h tag_map :: IO (Map.Map String (Set.Set S.ByteString)) tag_map = list ^ tag_map' for_resource :: [Tag] -> String -> [String] for_resource xs x = xs.select (resources > has (x.to_sb)) .map name fill_tag :: [Tag] -> Post.Post -> Post.Post fill_tag xs x = x { Post.tags = for_resource xs (x.Post.uid) } sorted :: [Tag] -> [Tag] sorted xs = xs .sortBy(compare_by (\x -> (x.resources.Set.size, x.name))) .reverse name_to_id :: SC name_to_id x = static_config.tag_id / x