diff --git a/Handler/Commons.hs b/Handler/Commons.hs index 28b370b..822d851 100755 --- a/Handler/Commons.hs +++ b/Handler/Commons.hs @@ -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) diff --git a/Handler/Search.hs b/Handler/Search.hs index 0c71cd8..39addb6 100755 --- a/Handler/Search.hs +++ b/Handler/Search.hs @@ -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 diff --git a/Migrations/0.0.3-0.0.4/Migration.hs b/Migrations/0.0.3-0.0.4/Migration.hs index 54bf783..031ce82 100755 --- a/Migrations/0.0.3-0.0.4/Migration.hs +++ b/Migrations/0.0.3-0.0.4/Migration.hs @@ -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" diff --git a/Migrations/0.0.4-0.0.5/Migration.hs b/Migrations/0.0.4-0.0.5/Migration.hs index 22f5104..00a5deb 100755 --- a/Migrations/0.0.4-0.0.5/Migration.hs +++ b/Migrations/0.0.4-0.0.5/Migration.hs @@ -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) diff --git a/static/css/bootstrap.css.map b/static/css/bootstrap.css.map old mode 100644 new mode 100755 diff --git a/static/css/bootstrap.min.css b/static/css/bootstrap.min.css old mode 100644 new mode 100755