This commit is contained in:
nek0 2015-10-25 22:23:00 +01:00
parent 0fcbbed76e
commit 1f88dbebd1
6 changed files with 30 additions and 30 deletions

View file

@ -19,7 +19,7 @@ module Handler.Commons where
import Import
import Data.String
import Database.Bloodhound
import Control.Monad (when)
import Control.Monad (unless)
import Network.HTTP.Client
import Network.HTTP.Types.Status as S
import qualified Data.ByteString.Char8 as C
@ -96,7 +96,7 @@ putIndexES input = do
resp <- case input of
ESUser uId user -> do
ex <- runBH' $ indexExists (IndexName "user")
when (not ex) ((\ _ -> do
unless ex ((\ _ -> do
runBH' $ createIndex is (IndexName "user")
return ()
) ex)
@ -104,7 +104,7 @@ putIndexES input = do
runBH' $ indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings user (DocId $ extractKey uId)
ESAlbum aId album -> do
ex <- runBH' $ indexExists (IndexName "album")
when (not ex) ((\ _ -> do
unless ex ((\ _ -> do
runBH' $ createIndex is (IndexName "album")
return ()
) ex)
@ -112,7 +112,7 @@ putIndexES input = do
runBH' $ indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings album (DocId $ extractKey aId)
ESMedium mId medium -> do
ex <- runBH' $ indexExists (IndexName "medium")
when (not ex) ((\ _ -> do
unless ex ((\ _ -> do
runBH' $ createIndex is (IndexName "medium")
return ()
) ex)
@ -120,7 +120,7 @@ putIndexES input = do
runBH' $ indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings medium (DocId $ extractKey mId)
ESComment cId comment -> do
ex <- runBH' $ indexExists (IndexName "comment")
when (not ex) ((\ _ -> do
unless ex ((\ _ -> do
runBH' $ createIndex is (IndexName "comment")
return ()
) ex)

View file

@ -32,23 +32,23 @@ getSearchR = do
case res of
FormSuccess query -> do
(ru, ra, rm, rc) <- getResults query
a <- return $ (decode (responseBody ru) :: Maybe (SearchResult SearchUser))
b <- return $ (decode (responseBody ra) :: Maybe (SearchResult SearchAlbum))
c <- return $ (decode (responseBody rm) :: Maybe (SearchResult SearchMedium))
d <- return $ (decode (responseBody rc) :: Maybe (SearchResult SearchComment))
hitListA <- case a of
Just as -> return $ hits $ searchHits as
Nothing -> return []
hitListB <- case b of
Just bs -> return $ hits $ searchHits bs
Nothing -> return []
hitListC <- case c of
Just cs -> return $ hits $ searchHits cs
Nothing -> return []
hitListD <- case d of
Just ds -> return $ hits $ searchHits ds
Nothing -> return []
userIdList <- return $ catMaybes $ map (\h -> do
let a = decode (responseBody ru) :: Maybe (SearchResult SearchUser)
let b = decode (responseBody ra) :: Maybe (SearchResult SearchAlbum)
let c = decode (responseBody rm) :: Maybe (SearchResult SearchMedium)
let d = decode (responseBody rc) :: Maybe (SearchResult SearchComment)
let hitListA = case a of {
Just as -> hits $ searchHits as;
Nothing -> []}
let hitListB = case b of {
Just bs -> hits $ searchHits bs;
Nothing -> []}
let hitListC = case c of {
Just cs -> hits $ searchHits cs;
Nothing -> []}
let hitListD = case d of {
Just ds -> hits $ searchHits ds;
Nothing -> []}
userIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "user"
then do
@ -57,7 +57,7 @@ getSearchR = do
else
Nothing
) hitListA
albumIdList <- return $ catMaybes $ map (\h -> do
albumIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "album"
then do
@ -66,7 +66,7 @@ getSearchR = do
else
Nothing
) hitListB
mediumIdList <- return $ catMaybes $ map (\h -> do
mediumIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "medium"
then do
@ -75,7 +75,7 @@ getSearchR = do
else
Nothing
) hitListC
commentIdList <- return $ catMaybes $ map (\h -> do
commentIdList <- return $ mapMaybe (\h -> do
if
hitIndex h == IndexName "comment"
then do

View file

@ -29,7 +29,7 @@ main = do
_ <- execute stmt1 []
rows <- fetchAllRowsAL stmt1
-- mapM_ (putStrLn . show) rows
tups <- sequence $ map (\entry ->
tups <- mapM (\entry ->
case entry of
[("id", theId), _, ("path", SqlByteString path), _, _, _, ("owner", SqlInteger owner), _, _, _, _, ("album", SqlInteger album), _, _] -> do
let newName = takeBaseName (B.unpack path) ++ "_preview.jpg"

View file

@ -72,7 +72,7 @@ main = do
_ <- createIndex indexSettings (IndexName "album")
_ <- createIndex indexSettings (IndexName "medium")
_ <- createIndex indexSettings (IndexName "comment")
_ <- sequence $ map (\entry ->
_ <- mapM (\entry ->
case entry of
[("id", SqlInteger theId), ("name", SqlByteString name), ("slug", SqlByteString slug), _, _, _, _, _] -> do
let u = SUser (decodeUtf8 name) (decodeUtf8 slug)
@ -86,7 +86,7 @@ main = do
bla ->
error $ "malformed entry" ++ show bla
) userRows
_ <- sequence $ map (\entry ->
_ <- mapM (\entry ->
case entry of
[("id", SqlInteger theId), ("title", SqlByteString title), _, _, _, _, _] -> do
let a = SAlbum (decodeUtf8 title)
@ -100,7 +100,7 @@ main = do
bla ->
error $ "malformed entry: " ++ show bla
) albumRows
_ <- sequence $ map (\entry ->
_ <- mapM (\entry ->
case entry of
[("id", SqlInteger theId), ("title", SqlByteString title), _, _, _, ("time", SqlZonedTime time), _, ("description", SqlByteString desc), ("tags", SqlByteString tags), _, _, _, _, _] -> do
let m = SMedium (decodeUtf8 title) (zonedTimeToUTC time) (decodeUtf8 desc) (parseTags tags)
@ -114,7 +114,7 @@ main = do
bla ->
error $ "malformed entry" ++ show bla
) mediumRows
_ <- sequence $ map (\entry ->
_ <- mapM (\entry ->
case entry of
[("id", SqlInteger theId), _, ("author_slug", SqlByteString author), _, _, ("time", SqlZonedTime time), ("content", SqlByteString content)] -> do
let c = SComment (decodeUtf8 author) (zonedTimeToUTC time) (decodeUtf8 content)

0
static/css/bootstrap.css.map Normal file → Executable file
View file

0
static/css/bootstrap.min.css vendored Normal file → Executable file
View file