module Bamboo.Helper where
import Bamboo.Helper.ByteString
import Bamboo.Helper.PreludeEnv hiding (at)
import Bamboo.Helper.Translation
import Bamboo.Type
import Bamboo.Type.Reader
import Bamboo.Type.StaticWidget hiding (name, body, reader)
import Control.Monad (liftM2, when)
import Data.Default
import Data.Maybe
import Hack.Contrib.Utils (script_name)
import Hack (Env)
import System.Directory
import System.FilePath.Posix hiding ((<.>))
import System.IO as IO
import Text.XHtml.Strict hiding (p, meta, body, select, name)
import qualified Bamboo.Type.Theme as Theme
import qualified Prelude as P
import qualified Text.XHtml.Strict as Html
gt :: (Ord a) => a -> a -> Bool
gt = (P.>)
ffmap :: (Functor f, Functor f1) =>
(a -> b) -> f1 (f a) -> f1 (f b)
ffmap f = fmap (fmap f)
(^^) :: (Functor f, Functor f1) => f1 (f a) -> (a -> b) -> f1 (f b)
(^^) x f = fmap (fmap f) x
whenM :: (Monad m) => m Bool -> m () -> m ()
whenM b x = b >>= flip when x
parse_config :: String -> IO Assoc
parse_config x = do
s <- read_file x
s
.filter_comment
.lines.map strip
.map (split "\\s*=\\s*")
.map fill_snd_blank
.map tuple2
.return
where
fill_snd_blank [y] = [y,""]
fill_snd_blank xs = xs
write_config :: FilePath -> Assoc -> IO ()
write_config s xs =
xs.map(\(x, y) -> x ++ " = " ++ y) .join "\n" .write_file s
empty_html :: Html
empty_html = toHtml ""
show_data :: (Show a) => a -> [Char]
show_data = show > snake_case
ifM :: (Monad m) => m Bool -> m b -> m b -> m b
ifM p t f = p >>= (\p' -> if p' then t else f)
parse_boolean :: String -> Bool
parse_boolean = belongs_to ["true", "1", "y", "yes", "yeah"]
mkdir :: String -> IO ()
mkdir = u2b > createDirectory
type SIO = String -> IO ()
take_directory :: SC
take_directory = u2b > takeDirectory > b2u
with_file :: String -> IOMode -> (Handle -> IO a) -> IO a
with_file s m f = IO.withFile (s.u2b) m f
id_to_type :: SC
id_to_type x = x.split "/" .first
id_to_resource :: SC
id_to_resource x = x.split "/" .tail.join "/"
read_data :: (Read a) => String -> a
read_data s = s.camel_case.read
read_data_list :: (Read a) => [String] -> [a]
read_data_list xs = xs.map read_data
take_extension :: SC
take_extension = takeExtension
take_known_extension :: SC
take_known_extension s
| ext.belongs_to exts = ext
| otherwise = ""
where
ext = s.take_extension
exts = readers.only_snd.join'
drop_known_extension :: SC
drop_known_extension s
| s.take_extension.belongs_to exts = dropExtension s
| otherwise = s
where exts = readers.only_snd.join'
remove_trailing_slash :: SC
remove_trailing_slash s = if s.last.is '/' then s.init else s
parse_list :: String -> [String]
parse_list s = s.split "," .map strip .reject null
static_config :: Config
static_config = purify $ do
return def
>>= set_blog_title ( for_s BlogTitle )
>>= set_blog_subtitle ( for_s BlogSubtitle )
>>= set_host_name ( for_s HostName )
>>= set_author_email ( for_s AuthorEmail )
>>= set_per_page ( for_i PerPage )
>>= set_navigation ( for_l Navigation ^^ (home_nav :) )
>>= set_bamboo_url ( for_s BambooUrl )
>>= set_sidebar ( for_l Sidebar >>= load_sidebar )
>>= set_footer ( for_s Footer >>= load_footer )
>>= set_favicon ( for_s Favicon )
>>= set_analytics_account_id ( for_s AnalyticsAccountId )
>>= set_extensions ( for_l Extensions ^^ read_data_list )
>>= set_theme_config ( for_s Theme >>= get_theme_config )
>>= set_post_date_format ( for_s PostDateFormat )
>>= set_comment_date_format ( for_s CommentDateFormat )
>>= set_url_date_format ( for_s UrlDateFormat )
>>= set_url_date_matcher ( for_s UrlDateMatcher )
>>= set_url_title_subs ( for_s UrlTitleSubs ^^ (as_l > read) )
>>= set_url_date_title_seperator ( for_s UrlDateTitleSeperator )
>>= set_cut ( for_s Cut )
>>= set_summary_for_root ( for_b SummaryForRoot )
>>= set_summary_for_tag ( for_b SummaryForTag )
>>= set_summary_for_rss ( for_b SummaryForRss )
>>= set_picture_prefix ( for_s PicturePrefix )
>>= set_number_of_latest_posts ( for_i NumberOfLatestPosts )
>>= set_use_cache ( for_b UseCache )
where
user_config = parse_config $ def.config_uri
for x = user_config ^ lookup (x.show_data)
for_s = for
for_i = for > (^^ read)
for_l = for > (^^ parse_list)
for_b = for > (^^ parse_boolean)
load_widget x = do
exists <- x.file_exist
if exists
then do
w <- read_static_widget def x
return $ (Just w)
else
return Nothing
load_sidebar_item = (def.footer_uri / ) > load_widget
load_sidebar Nothing = return Nothing
load_sidebar (Just xs) =
xs
. mapM load_sidebar_item
^ filter isJust
^ map fromJust
^ Just
load_footer Nothing = return Nothing
load_footer (Just s) = (def.footer_uri / s) .load_widget ^ Just
as_l s = "[" ++ s ++ "]"
get_theme_config Nothing = return Nothing
get_theme_config (Just user_theme_name) = do
let user_theme_uri = (def.theme_uri / user_theme_name) ++ ".txt"
exists <- user_theme_uri.file_exist
if exists
then
parse_config user_theme_uri
^ (("name", user_theme_name) : )
^ to_theme
^ Just
else return Nothing
c (Just _) _ y = y
c Nothing x _ = x
p = fromJust
r = return
set_analytics_account_id v' x = v' >>= \v -> r $ c v x $ x { analytics_account_id = p v}
set_author_email v' x = v' >>= \v -> r $ c v x $ x { author_email = p v}
set_bamboo_url v' x = v' >>= \v -> r $ c v x $ x { bamboo_url = p v}
set_blog_subtitle v' x = v' >>= \v -> r $ c v x $ x { blog_subtitle = p v}
set_blog_title v' x = v' >>= \v -> r $ c v x $ x { blog_title = p v}
set_comment_date_format v' x = v' >>= \v -> r $ c v x $ x { comment_date_format = p v}
set_cut v' x = v' >>= \v -> r $ c v x $ x { cut = p v}
set_extensions v' x = v' >>= \v -> r $ c v x $ x { extensions = p v}
set_favicon v' x = v' >>= \v -> r $ c v x $ x { favicon = p v}
set_footer v' x = v' >>= \v -> r $ c v x $ x { footer = p v}
set_host_name v' x = v' >>= \v -> r $ c v x $ x { host_name = p v}
set_navigation v' x = v' >>= \v -> r $ c v x $ x { navigation = p v}
set_number_of_latest_posts v' x = v' >>= \v -> r $ c v x $ x { number_of_latest_posts = p v}
set_per_page v' x = v' >>= \v -> r $ c v x $ x { per_page = p v}
set_picture_prefix v' x = v' >>= \v -> r $ c v x $ x { picture_prefix = p v}
set_post_date_format v' x = v' >>= \v -> r $ c v x $ x { post_date_format = p v}
set_sidebar v' x = v' >>= \v -> r $ c v x $ x { sidebar = p v}
set_summary_for_root v' x = v' >>= \v -> r $ c v x $ x { summary_for_root = p v}
set_summary_for_rss v' x = v' >>= \v -> r $ c v x $ x { summary_for_rss = p v}
set_summary_for_tag v' x = v' >>= \v -> r $ c v x $ x { summary_for_tag = p v}
set_theme_config v' x = v' >>= \v -> r $ c v x $ x { theme_config = p v}
set_url_date_format v' x = v' >>= \v -> r $ c v x $ x { url_date_format = p v}
set_url_date_matcher v' x = v' >>= \v -> r $ c v x $ x { url_date_matcher = p v}
set_url_date_title_seperator v' x = v' >>= \v -> r $ c v x $ x { url_date_title_seperator = p v}
set_url_title_subs v' x = v' >>= \v -> r $ c v x $ x { url_title_subs = p v}
set_use_cache v' x = v' >>= \v -> r $ c v x $ x { use_cache = p v}
db_uri :: Config -> String
flat_uri :: Config -> String
public_uri :: Config -> String
image_uri :: Config -> String
config_uri :: Config -> String
sidebar_uri :: Config -> String
footer_uri :: Config -> String
post_uri :: Config -> String
tag_uri :: Config -> String
comment_uri :: Config -> String
theme_uri :: Config -> String
album_uri :: Config -> String
topic_uri :: Config -> String
stat_uri :: Config -> String
cache_uri :: Config -> String
db_uri x = x.db_id
flat_uri x = x.db_uri / x.flat_id
public_uri x = x.db_uri / x.public_id
image_uri x = x.public_uri / x.image_id
config_uri x = x.flat_uri / x.config_id / x.config_file_id
sidebar_uri x = x.flat_uri / x.config_id / x.sidebar_id
footer_uri x = x.flat_uri / x.config_id
post_uri x = x.flat_uri / x.post_id
tag_uri x = x.flat_uri / x.tag_id
comment_uri x = x.flat_uri / x.comment_id
theme_uri x = x.flat_uri / x.config_id / x.theme_id
album_uri x = x.image_uri / x.album_id
topic_uri x = x.flat_uri / x.topic_id
stat_uri x = x.flat_uri / x.stat_id
cache_uri x = x.flat_uri / x.cache_id
read_static_widget :: Reader -> String -> IO StaticWidget
read_static_widget user_reader s = liftM2 (StaticWidget name) body (return reader) where
body = s.read_bytestring
reader = s.take_extension.guess_reader.fromMaybe user_reader
name = s.takeFileName.drop_known_extension
to_theme :: Assoc -> Theme.ThemeConfig
to_theme xs = Theme.ThemeConfig
{ Theme.name = at Theme.Name
, Theme.css = at Theme.Css .css_list
, Theme.js = at Theme.Js .js_list
}
where
at s = xs.lookup (s.show_data) .fromJust
css_list s = s.parse_list.map
(\x -> "theme/" ++ at Theme.Name ++ "/css/" ++ x ++ ".css")
js_list s = s.parse_list.map
(\x -> "theme/" ++ at Theme.Name ++ "/js/" ++ x ++ ".js")
slashed_script_name :: Env -> String
slashed_script_name env = "/" / env.script_name