module Handler.Common where
import Import
import Data.FileEmbed (embedFile)
import Text.Read
import Data.Aeson as A
getFaviconR :: Handler TypedContent
getFaviconR :: Handler TypedContent
getFaviconR = do forall (m :: * -> *). MonadHandler m => Int -> m ()
cacheSeconds forall a b. (a -> b) -> a -> b
$ Int
60 forall a. Num a => a -> a -> a
* Int
5
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Content -> TypedContent
TypedContent ByteString
"image/x-icon"
forall a b. (a -> b) -> a -> b
$ forall a. ToContent a => a -> Content
toContent $(embedFile "config/favicon.ico")
getRobotsR :: Handler TypedContent
getRobotsR :: Handler TypedContent
getRobotsR = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> Content -> TypedContent
TypedContent ByteString
typePlain
forall a b. (a -> b) -> a -> b
$ forall a. ToContent a => a -> Content
toContent $(embedFile "config/robots.txt")
lookupPagingParams :: Handler (Maybe Int64, Maybe Int64)
lookupPagingParams :: Handler (Maybe Int64, Maybe Int64)
lookupPagingParams =
(,)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Show a, Read a) => Text -> Handler (Maybe a)
getUrlSessionParam Text
"count"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Read a => Text -> Handler (Maybe a)
getUrlParam Text
"page"
getUrlParam :: (Read a) => Text -> Handler (Maybe a)
getUrlParam :: forall a. Read a => Text -> Handler (Maybe a)
getUrlParam Text
name = do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a} {b}.
(Element a ~ Char, Read b, MonoFoldable a) =>
Maybe a -> Maybe b
parseMaybe (forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
name)
where
parseMaybe :: Maybe a -> Maybe b
parseMaybe Maybe a
x = forall a. Read a => String -> Maybe a
readMaybe forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
unpack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe a
x
getUrlSessionParam :: forall a.
(Show a, Read a)
=> Text
-> Handler (Maybe a)
getUrlSessionParam :: forall a. (Show a, Read a) => Text -> Handler (Maybe a)
getUrlSessionParam Text
name = do
Maybe a
p <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Text -> Maybe a
parseMaybe (forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupGetParam Text
name)
Maybe a
s <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Text -> Maybe a
parseMaybe (forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession Text
name)
forall mono (f :: * -> *) b.
(MonoFoldable mono, Applicative f) =>
mono -> (Element mono -> f b) -> f ()
for_ Maybe a
p (forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession Text
name forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (forall seq. IsSequence seq => [Element seq] -> seq
pack forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> String
show))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a
p forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
s)
where
parseMaybe :: Maybe Text -> Maybe a
parseMaybe :: Maybe Text -> Maybe a
parseMaybe Maybe Text
x = forall a. Read a => String -> Maybe a
readMaybe forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall mono. MonoFoldable mono => mono -> [Element mono]
unpack forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Text
x
lookupTagCloudMode :: MonadHandler m => m (Maybe TagCloudMode)
lookupTagCloudMode :: forall (m :: * -> *). MonadHandler m => m (Maybe TagCloudMode)
lookupTagCloudMode = do
(forall a. FromJSON a => ByteString -> Maybe a
A.decode forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall lazy strict. LazySequence lazy strict => strict -> lazy
fromStrict forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadHandler m =>
Text -> m (Maybe ByteString)
lookupSessionBS Text
"tagCloudMode"
setTagCloudMode :: MonadHandler m => TagCloudMode -> m ()
setTagCloudMode :: forall (m :: * -> *). MonadHandler m => TagCloudMode -> m ()
setTagCloudMode = forall (m :: * -> *). MonadHandler m => Text -> ByteString -> m ()
setSessionBS Text
"tagCloudMode" forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall lazy strict. LazySequence lazy strict => lazy -> strict
toStrict forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. ToJSON a => a -> ByteString
A.encode
getTagCloudMode :: MonadHandler m => Bool -> [Tag] -> m TagCloudMode
getTagCloudMode :: forall (m :: * -> *).
MonadHandler m =>
Bool -> [Text] -> m TagCloudMode
getTagCloudMode Bool
isowner [Text]
tags = do
Maybe TagCloudMode
ms <- forall (m :: * -> *). MonadHandler m => m (Maybe TagCloudMode)
lookupTagCloudMode
let expanded :: Bool
expanded = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False TagCloudMode -> Bool
isExpanded Maybe TagCloudMode
ms
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
if Bool -> Bool
not Bool
isowner
then TagCloudMode
TagCloudModeNone
else if Bool -> Bool
not (forall mono. MonoFoldable mono => mono -> Bool
null [Text]
tags)
then Bool -> [Text] -> TagCloudMode
TagCloudModeRelated Bool
expanded [Text]
tags
else case Maybe TagCloudMode
ms of
Maybe TagCloudMode
Nothing -> Bool -> Int -> TagCloudMode
TagCloudModeTop Bool
expanded Int
200
Just (TagCloudModeRelated Bool
e [Text]
_) -> Bool -> Int -> TagCloudMode
TagCloudModeTop Bool
e Int
200
Just TagCloudMode
m -> TagCloudMode
m