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

View file

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

View file

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

View file

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