Merge branch 'elasticsearch'
This commit is contained in:
nek0
commit
ccf5f192ad
29 changed files with 736 additions and 15 deletions
|
|
@ -68,6 +68,7 @@ import Handler.AdminMediumSettings
|
|||
import Handler.AdminComments
|
||||
import Handler.Tag
|
||||
import Handler.RootFeed
|
||||
import Handler.Search
|
||||
|
||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||
|
|
|
|||
|
|
@ -94,6 +94,17 @@ renderLayout widget = do
|
|||
copyrightWidget <- widgetToPageContent $
|
||||
$(widgetFile "copyrightFooter")
|
||||
|
||||
searchWidget <- widgetToPageContent $ [whamlet|
|
||||
<form action=@{SearchR} method=GET>
|
||||
<input type="hidden" name="_hasdata">
|
||||
<div .required>
|
||||
<label for="hident2">
|
||||
<input #hident2 type="search" autofocus="" required="" name="f1">
|
||||
<script>
|
||||
if (!('autofocus' in document.createElement('input'))) {document.getElementById('hident2').focus();}
|
||||
<input value="Search" type="submit">
|
||||
|]
|
||||
|
||||
wc <- widgetToPageContent widget
|
||||
|
||||
pc <- widgetToPageContent $ do
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
module Handler.Activate where
|
||||
|
||||
import Import as I hiding (returnJson)
|
||||
import Handler.Commons
|
||||
import Data.Text
|
||||
import Data.Text.Encoding
|
||||
import Data.Maybe
|
||||
|
|
@ -73,6 +74,8 @@ postActivateR token = do
|
|||
-- create user directory
|
||||
liftIO $ createDirectoryIfMissing True $
|
||||
"static" </> "data" </> unpack (extractKey uId)
|
||||
-- input user to elasticsearch
|
||||
putIndexES (ESUser uId $ activatorUser activ)
|
||||
-- cleanup
|
||||
runDB $ delete aId
|
||||
runDB $ delete uTokenId
|
||||
|
|
|
|||
|
|
@ -97,6 +97,7 @@ postAdminAlbumSettingsR albumId = do
|
|||
, AlbumSamplePic =. albumSamplePic temp
|
||||
, AlbumSampleWidth =. width
|
||||
]
|
||||
putIndexES (ESAlbum albumId temp)
|
||||
setMessage "Album settings changed successfully"
|
||||
redirect AdminR
|
||||
_ -> do
|
||||
|
|
@ -144,10 +145,23 @@ getAdminAlbumDeleteR albumId = do
|
|||
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
|
||||
-- delete comments
|
||||
commEnts <- runDB $ selectList [CommentOrigin ==. a] []
|
||||
_ <- mapM (runDB . delete . entityKey) commEnts
|
||||
_ <- mapM (\c -> do
|
||||
-- delete comment from elasticsearch
|
||||
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] []
|
||||
_ <- mapM (\child -> do
|
||||
-- delete comment children from elasticsearch and db
|
||||
deleteIndexES (ESComment (entityKey child) (entityVal child))
|
||||
runDB $ delete $ entityKey child
|
||||
) children
|
||||
deleteIndexES (ESComment (entityKey c) (entityVal c))
|
||||
runDB $ delete $ entityKey c) commEnts
|
||||
-- delete album from elasticsearch
|
||||
deleteIndexES (ESAlbum albumId album)
|
||||
-- delete album database entry
|
||||
runDB $ delete a
|
||||
) (albumContent album)
|
||||
-- delete from elasticsearch
|
||||
deleteIndexES (ESAlbum albumId album)
|
||||
-- delete album
|
||||
runDB $ delete albumId
|
||||
-- delete files
|
||||
|
|
|
|||
|
|
@ -43,11 +43,14 @@ getAdminCommentDeleteR commentId = do
|
|||
Right _ -> do
|
||||
tempComment <- runDB $ get commentId
|
||||
case tempComment of
|
||||
Just _ -> do
|
||||
Just comment -> do
|
||||
-- delete comment children
|
||||
children <- runDB $ selectList [CommentParent ==. Just commentId] []
|
||||
_ <- mapM (runDB . delete . entityKey) children
|
||||
_ <- mapM (\child -> do
|
||||
deleteIndexES (ESComment (entityKey child) (entityVal child))
|
||||
runDB $ delete $ entityKey child) children
|
||||
-- delete comment itself
|
||||
deleteIndexES (ESComment commentId comment)
|
||||
runDB $ delete commentId
|
||||
setMessage "Comment deleted succesfully"
|
||||
redirect AdminR
|
||||
|
|
|
|||
|
|
@ -71,6 +71,7 @@ postAdminMediumSettingsR mediumId = do
|
|||
, MediumDescription =. mediumDescription temp
|
||||
, MediumTags =. mediumTags temp
|
||||
]
|
||||
putIndexES $ ESMedium mediumId temp
|
||||
setMessage "Medium settings changed successfully"
|
||||
redirect AdminR
|
||||
_ -> do
|
||||
|
|
@ -115,8 +116,17 @@ getAdminMediumDeleteR mediumId = do
|
|||
runDB $ update albumId [AlbumContent =. newMediaList]
|
||||
-- delete comments
|
||||
commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
|
||||
_ <- mapM (runDB . delete . entityKey) commEnts
|
||||
_ <- mapM (\ent -> do
|
||||
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
|
||||
_ <- mapM (\child -> do
|
||||
-- delete comment children
|
||||
deleteIndexES $ ESComment (entityKey child) (entityVal child)
|
||||
runDB $ delete $ entityKey child
|
||||
) children
|
||||
deleteIndexES $ ESComment (entityKey ent) (entityVal ent)
|
||||
runDB $ delete $ entityKey ent) commEnts
|
||||
-- delete medium
|
||||
deleteIndexES $ ESMedium mediumId medium
|
||||
runDB $ delete mediumId
|
||||
-- delete files
|
||||
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
|
||||
|
|
|
|||
|
|
@ -113,6 +113,7 @@ postAdminProfileSettingsR ownerId = do
|
|||
, UserEmail =. userEmail temp
|
||||
, UserAdmin =. userAdmin temp
|
||||
]
|
||||
putIndexES $ ESUser ownerId temp
|
||||
setMessage "User data updated successfully"
|
||||
redirect AdminR
|
||||
_ -> do
|
||||
|
|
@ -151,16 +152,27 @@ getAdminProfileDeleteR ownerId = do
|
|||
_ <- mapM (\med -> do
|
||||
-- delete comments
|
||||
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
|
||||
_ <- mapM (runDB . delete . entityKey) commEnts
|
||||
_ <- mapM (\ent -> do
|
||||
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
|
||||
_ <- mapM (\child -> do
|
||||
-- delete comment children
|
||||
deleteIndexES $ ESComment (entityKey child) (entityVal child)
|
||||
runDB $ delete $ entityKey child
|
||||
) children
|
||||
runDB $ delete $ entityKey ent) commEnts
|
||||
-- delete media files
|
||||
medium <- runDB $ getJust med
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
|
||||
-- delete medium database entry
|
||||
-- delete medium database entry and search
|
||||
ium <- runDB $ getJust med
|
||||
deleteIndexES $ ESMedium med ium
|
||||
runDB $ delete med
|
||||
) mediaList
|
||||
deleteIndexES $ ESAlbum albumId album
|
||||
runDB $ delete albumId
|
||||
) albumList
|
||||
deleteIndexES $ ESUser ownerId owner
|
||||
runDB $ delete ownerId
|
||||
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey ownerId)
|
||||
setMessage "User successfully deleted"
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
module Handler.AlbumSettings where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import qualified Data.Text as T
|
||||
import Data.Maybe
|
||||
import System.Directory
|
||||
|
|
@ -110,6 +111,7 @@ postAlbumSettingsR albumId = do
|
|||
, AlbumSamplePic =. albumSamplePic temp
|
||||
, AlbumSampleWidth =. width
|
||||
]
|
||||
putIndexES (ESAlbum albumId temp)
|
||||
setMessage "Album settings changed succesfully"
|
||||
redirect $ AlbumR albumId
|
||||
_ -> do
|
||||
|
|
@ -194,15 +196,28 @@ postAlbumDeleteR albumId = do
|
|||
medium <- runDB $ getJust a
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
|
||||
-- delete medium from elasticsearch
|
||||
deleteIndexES (ESMedium a medium)
|
||||
-- delete comments
|
||||
commEnts <- runDB $ selectList [CommentOrigin ==. a] []
|
||||
_ <- mapM (runDB . delete . entityKey) commEnts
|
||||
_ <- mapM (\c -> do
|
||||
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey c)] []
|
||||
_ <- mapM (\child -> do
|
||||
-- delete comment children from elasticsearch and db
|
||||
deleteIndexES (ESComment (entityKey child) (entityVal child))
|
||||
runDB $ delete $ entityKey child
|
||||
) children
|
||||
-- delete comment from elasticsearch
|
||||
deleteIndexES (ESComment (entityKey c) (entityVal c))
|
||||
runDB $ delete $ entityKey c) commEnts
|
||||
runDB $ delete a
|
||||
) (albumContent album)
|
||||
-- delete album
|
||||
runDB $ delete albumId
|
||||
-- delete files
|
||||
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId) </> T.unpack (extractKey albumId)
|
||||
-- delete from elasticsearch
|
||||
deleteIndexES (ESAlbum albumId album)
|
||||
-- outro
|
||||
setMessage "Album deleted succesfully"
|
||||
redirect HomeR
|
||||
|
|
|
|||
|
|
@ -18,6 +18,14 @@ module Handler.Commons where
|
|||
|
||||
import Import
|
||||
import Data.String
|
||||
import Database.Bloodhound
|
||||
import Control.Monad (when)
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Types.Status as S
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
|
||||
|
||||
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
|
||||
loginIsAdmin = do
|
||||
|
|
@ -78,3 +86,71 @@ mediumCheck mediumId = do
|
|||
return $ Left ("You must be logged in to change settings", LoginR)
|
||||
Nothing ->
|
||||
return $ Left ("This medium does not exist", HomeR)
|
||||
|
||||
putIndexES :: ESInput -> Handler ()
|
||||
putIndexES input = do
|
||||
master <- getYesod
|
||||
let shards = appShards $ appSettings master
|
||||
let replicas = appReplicas $ appSettings master
|
||||
let is = IndexSettings (ShardCount shards) (ReplicaCount replicas)
|
||||
resp <- case input of
|
||||
ESUser uId user -> do
|
||||
ex <- runBH' $ indexExists (IndexName "user")
|
||||
when (not ex) ((\ _ -> do
|
||||
runBH' $ createIndex is (IndexName "user")
|
||||
return ()
|
||||
) ex)
|
||||
_ <- runBH' $ openIndex (IndexName "user")
|
||||
runBH' $ indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings user (DocId $ extractKey uId)
|
||||
ESAlbum aId album -> do
|
||||
ex <- runBH' $ indexExists (IndexName "album")
|
||||
when (not ex) ((\ _ -> do
|
||||
runBH' $ createIndex is (IndexName "album")
|
||||
return ()
|
||||
) ex)
|
||||
_ <- runBH' $ openIndex (IndexName "album")
|
||||
runBH' $ indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings album (DocId $ extractKey aId)
|
||||
ESMedium mId medium -> do
|
||||
ex <- runBH' $ indexExists (IndexName "medium")
|
||||
when (not ex) ((\ _ -> do
|
||||
runBH' $ createIndex is (IndexName "medium")
|
||||
return ()
|
||||
) ex)
|
||||
_ <- runBH' $ openIndex (IndexName "medium")
|
||||
runBH' $ indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings medium (DocId $ extractKey mId)
|
||||
ESComment cId comment -> do
|
||||
ex <- runBH' $ indexExists (IndexName "comment")
|
||||
when (not ex) ((\ _ -> do
|
||||
runBH' $ createIndex is (IndexName "comment")
|
||||
return ()
|
||||
) ex)
|
||||
_ <- runBH' $ openIndex (IndexName "comment")
|
||||
runBH' $ indexDocument (IndexName "comment") (MappingName "comment") defaultIndexDocumentSettings comment (DocId $ extractKey cId)
|
||||
case statusCode (responseStatus resp) of
|
||||
201 -> return ()
|
||||
200 -> return ()
|
||||
code -> error $ (show code) ++ ": " ++ (C.unpack $ BL.toStrict $ responseBody resp)
|
||||
|
||||
deleteIndexES :: ESInput -> Handler ()
|
||||
deleteIndexES input = do
|
||||
resp <- case input of
|
||||
ESUser uId user ->
|
||||
runBH' $ deleteDocument (IndexName "user") (MappingName "user") (DocId $ extractKey uId)
|
||||
ESAlbum aId album ->
|
||||
runBH' $ deleteDocument (IndexName "album") (MappingName "album") (DocId $ extractKey aId)
|
||||
ESMedium mId medium ->
|
||||
runBH' $ deleteDocument (IndexName "medium") (MappingName "medium") (DocId $ extractKey mId)
|
||||
ESComment cId comment ->
|
||||
runBH' $ deleteDocument (IndexName "comment") (MappingName "comment") (DocId $ extractKey cId)
|
||||
case statusCode (responseStatus resp) of
|
||||
201 -> return ()
|
||||
200 -> return ()
|
||||
_ -> error $ C.unpack $ BL.toStrict $ responseBody resp
|
||||
|
||||
-- runBH' :: BH m a -> Handler resp
|
||||
runBH' action = do
|
||||
master <- getYesod
|
||||
let s = appSearchHost $ appSettings master
|
||||
let server = Server s
|
||||
manager <- liftIO $ newManager defaultManagerSettings
|
||||
runBH (BHEnv server manager) action
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
module Handler.Medium where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import Data.Time
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -85,7 +86,8 @@ postMediumR mediumId = do
|
|||
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId Nothing
|
||||
case res of
|
||||
FormSuccess temp -> do
|
||||
_ <- runDB $ insert temp
|
||||
cId <- runDB $ insert temp
|
||||
putIndexES (ESComment cId temp)
|
||||
--send mail to medium owner
|
||||
owner <- runDB $ getJust $ mediumOwner medium
|
||||
link <- ($ MediumR (commentOrigin temp)) <$> getUrlRender
|
||||
|
|
@ -158,7 +160,8 @@ postCommentReplyR commentId = do
|
|||
((res, _), _) <- runFormPost $ commentForm userId userSl mediumId (Just commentId)
|
||||
case res of
|
||||
FormSuccess temp -> do
|
||||
_ <- runDB $ insert temp
|
||||
cId <- runDB $ insert temp
|
||||
putIndexES (ESComment cId temp)
|
||||
--send mail to parent author
|
||||
parent <- runDB $ getJust $ fromJust $ commentParent temp
|
||||
parAuth <- runDB $ getJust $ commentAuthor parent
|
||||
|
|
@ -240,9 +243,14 @@ postCommentDeleteR commentId = do
|
|||
Just "confirm" -> do
|
||||
-- delete comment children
|
||||
childEnts <- runDB $ selectList [CommentParent ==. (Just commentId)] []
|
||||
_ <- mapM (\ent -> runDB $ delete $ entityKey ent) childEnts
|
||||
_ <- mapM (\ent -> do
|
||||
-- delete comment children from elasticsearch
|
||||
deleteIndexES (ESComment (entityKey ent) (entityVal ent))
|
||||
runDB $ delete $ entityKey ent) childEnts
|
||||
-- delete comment itself
|
||||
runDB $ delete commentId
|
||||
-- delete from elasticsearch
|
||||
deleteIndexES (ESComment commentId comment)
|
||||
-- outro
|
||||
setMessage "Your comment has been deleted"
|
||||
redirect $ MediumR $ commentOrigin comment
|
||||
|
|
|
|||
|
|
@ -49,6 +49,7 @@ postMediumSettingsR mediumId = do
|
|||
, MediumDescription =. mediumDescription temp
|
||||
, MediumTags =. mediumTags temp
|
||||
]
|
||||
putIndexES (ESMedium mediumId temp)
|
||||
setMessage "Medium settings changed succesfully"
|
||||
redirect $ MediumR mediumId
|
||||
_ -> do
|
||||
|
|
@ -107,6 +108,8 @@ postMediumDeleteR mediumId = do
|
|||
liftIO $ removeFile (normalise $ tail $ mediumPath medium)
|
||||
liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
|
||||
runDB $ delete mediumId
|
||||
-- delete form elasticsearch
|
||||
deleteIndexES (ESMedium mediumId medium)
|
||||
setMessage "Medium succesfully deleted"
|
||||
redirect HomeR
|
||||
_ -> do
|
||||
|
|
|
|||
|
|
@ -17,6 +17,7 @@
|
|||
module Handler.NewAlbum where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import Data.Text
|
||||
import System.Directory
|
||||
import System.FilePath
|
||||
|
|
@ -53,6 +54,8 @@ postNewAlbumR = do
|
|||
runDB $ update userId [UserAlbums =. newAlbumList]
|
||||
-- create folder
|
||||
liftIO $ createDirectory $ "static" </> "data" </> unpack (extractKey userId) </> unpack (extractKey albumId)
|
||||
-- update elasticsearch
|
||||
putIndexES (ESAlbum albumId album)
|
||||
-- outro
|
||||
setMessage "Album successfully created"
|
||||
redirect $ ProfileR userId
|
||||
|
|
|
|||
|
|
@ -51,14 +51,26 @@ postProfileDeleteR userId = do
|
|||
let mediaList = albumContent album
|
||||
_ <- mapM (\med -> do
|
||||
commEnts <- runDB $ selectList [CommentOrigin ==. med] []
|
||||
_ <- mapM (runDB . delete . entityKey) commEnts
|
||||
_ <- mapM (\ent -> do
|
||||
children <- runDB $ selectList [CommentParent ==. (Just $ entityKey ent)] []
|
||||
_ <- mapM (\child -> do
|
||||
-- delete comment children
|
||||
deleteIndexES $ ESComment (entityKey child) (entityVal child)
|
||||
runDB $ delete $ entityKey child
|
||||
) children
|
||||
-- delete comment
|
||||
deleteIndexES $ ESComment (entityKey ent) (entityVal ent)
|
||||
runDB $ delete $ entityKey ent) commEnts
|
||||
medium <- runDB $ getJust med
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumPath medium)
|
||||
liftIO $ removeFile (normalise $ L.tail $ mediumThumb medium)
|
||||
deleteIndexES (ESMedium med medium)
|
||||
runDB $ delete med
|
||||
) mediaList
|
||||
deleteIndexES $ ESAlbum albumId album
|
||||
runDB $ delete albumId
|
||||
) albumList
|
||||
deleteIndexES $ ESUser userId user
|
||||
runDB $ delete userId
|
||||
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId)
|
||||
deleteSession "userId"
|
||||
|
|
|
|||
|
|
@ -45,6 +45,7 @@ postProfileSettingsR userId = do
|
|||
, UserSlug =. userSlug temp
|
||||
, UserEmail =. userEmail temp
|
||||
]
|
||||
putIndexES (ESUser userId temp)
|
||||
setMessage "Profile settings changed successfully"
|
||||
redirect $ UserR $ userName user
|
||||
_ -> do
|
||||
|
|
|
|||
149
Handler/Search.hs
Executable file
149
Handler/Search.hs
Executable file
|
|
@ -0,0 +1,149 @@
|
|||
module Handler.Search where
|
||||
|
||||
import Import
|
||||
import Handler.Commons
|
||||
import Data.Time.Clock
|
||||
import Data.Aeson
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Database.Bloodhound
|
||||
import Network.HTTP.Client (responseBody)
|
||||
import System.FilePath.Posix
|
||||
|
||||
getSearchR :: Handler Html
|
||||
getSearchR = do
|
||||
((res, widget), _) <- runFormGet searchForm
|
||||
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
|
||||
if
|
||||
hitIndex h == IndexName "user"
|
||||
then do
|
||||
DocId theId <- return $ hitDocId h
|
||||
Just $ (packKey theId :: UserId)
|
||||
else
|
||||
Nothing
|
||||
) hitListA
|
||||
albumIdList <- return $ catMaybes $ map (\h -> do
|
||||
if
|
||||
hitIndex h == IndexName "album"
|
||||
then do
|
||||
DocId theId <- return $ hitDocId h
|
||||
Just $ (packKey theId :: AlbumId)
|
||||
else
|
||||
Nothing
|
||||
) hitListB
|
||||
mediumIdList <- return $ catMaybes $ map (\h -> do
|
||||
if
|
||||
hitIndex h == IndexName "medium"
|
||||
then do
|
||||
DocId theId <- return $ hitDocId h
|
||||
Just $ (packKey theId :: MediumId)
|
||||
else
|
||||
Nothing
|
||||
) hitListC
|
||||
commentIdList <- return $ catMaybes $ map (\h -> do
|
||||
if
|
||||
hitIndex h == IndexName "comment"
|
||||
then do
|
||||
DocId theId <- return $ hitDocId h
|
||||
Just $ (packKey theId :: CommentId)
|
||||
else
|
||||
Nothing
|
||||
) hitListD
|
||||
userList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [UserId ==. i] []) userIdList
|
||||
albumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [AlbumId ==. i] []) albumIdList
|
||||
mediumList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [MediumId ==. i] []) mediumIdList
|
||||
commentList <- return . catMaybes =<< mapM (\i -> runDB $ selectFirst [CommentId ==. i] []) commentIdList
|
||||
let allEmpty = (null userList) && (null albumList) && (null mediumList) && (null commentList)
|
||||
defaultLayout $ do
|
||||
setTitle $ toHtml $ "Eidolon :: Search results for " ++ (T.unpack query)
|
||||
$(widgetFile "result")
|
||||
_ ->
|
||||
defaultLayout $ do
|
||||
setTitle "Eidolon :: Search"
|
||||
$(widgetFile "search")
|
||||
|
||||
searchForm :: Form T.Text
|
||||
searchForm = renderDivs $ areq (searchField True) "Search" Nothing
|
||||
|
||||
getResults :: Text -> Handler (Reply, Reply, Reply, Reply)
|
||||
getResults query = do
|
||||
esQuery <- return $ QueryFuzzyLikeThisQuery $ FuzzyLikeThisQuery
|
||||
{ fuzzyLikeFields = [FieldName "_all"]
|
||||
, fuzzyLikeText = query
|
||||
, fuzzyLikeMaxQueryTerms = MaxQueryTerms 25
|
||||
, fuzzyLikeIgnoreTermFrequency = IgnoreTermFrequency False
|
||||
, fuzzyLikeFuzziness = Fuzziness 0.6
|
||||
, fuzzyLikePrefixLength = PrefixLength 0
|
||||
, fuzzyLikeBoost = Boost 1.0
|
||||
, fuzzyLikeAnalyzer = Nothing
|
||||
}
|
||||
su <- runBH' $ searchByIndex (IndexName "user") $ mkSearch (Just esQuery) Nothing
|
||||
sa <- runBH' $ searchByIndex (IndexName "album") $ mkSearch (Just esQuery) Nothing
|
||||
sm <- runBH' $ searchByIndex (IndexName "medium") $ mkSearch (Just esQuery) Nothing
|
||||
sc <- runBH' $ searchByIndex (IndexName "comment") $ mkSearch (Just esQuery) Nothing
|
||||
return (su, sa, sm, sc)
|
||||
|
||||
data SearchUser = SearchUser
|
||||
{ suName :: T.Text
|
||||
, suSlug :: T.Text
|
||||
}
|
||||
|
||||
instance FromJSON SearchUser where
|
||||
parseJSON (Object o) = SearchUser
|
||||
<$> o .: "name"
|
||||
<*> o .: "slug"
|
||||
parseJSON _ = mempty
|
||||
|
||||
data SearchAlbum = SearchAlbum
|
||||
{ saName :: T.Text }
|
||||
|
||||
instance FromJSON SearchAlbum where
|
||||
parseJSON (Object o) = SearchAlbum <$> o .: "name"
|
||||
parseJSON _ = mempty
|
||||
|
||||
data SearchMedium = SearchMedium
|
||||
{ smName :: Text
|
||||
, smTime :: UTCTime
|
||||
, smDescription :: Textarea
|
||||
, smTags :: [T.Text]
|
||||
}
|
||||
|
||||
instance FromJSON SearchMedium where
|
||||
parseJSON (Object o) = SearchMedium
|
||||
<$> o .: "name"
|
||||
<*> o .: "time"
|
||||
<*> o .: "description"
|
||||
<*> o .: "tags"
|
||||
parseJSON _ = mempty
|
||||
|
||||
data SearchComment = SearchComment
|
||||
{ scAuthor :: Text
|
||||
, scTime :: UTCTime
|
||||
, scContent :: Text
|
||||
}
|
||||
|
||||
instance FromJSON SearchComment where
|
||||
parseJSON (Object o) = SearchComment
|
||||
<$> o .: "author"
|
||||
<*> o .: "time"
|
||||
<*> o .: "content"
|
||||
parseJSON _ = mempty
|
||||
|
|
@ -17,6 +17,7 @@
|
|||
module Handler.Upload where
|
||||
|
||||
import Import as I
|
||||
import Handler.Commons
|
||||
import Data.Time
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
|
|
@ -90,6 +91,7 @@ postDirectUploadR albumId = do
|
|||
inALbum <- runDB $ getJust albumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update albumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
else
|
||||
return $ Just $ fileName file
|
||||
|
|
@ -251,6 +253,7 @@ postUploadR = do
|
|||
inALbum <- runDB $ getJust inAlbumId
|
||||
let newMediaList = mId : albumContent inALbum
|
||||
runDB $ update inAlbumId [AlbumContent =. newMediaList]
|
||||
putIndexES (ESMedium mId medium)
|
||||
return Nothing
|
||||
else
|
||||
return $ Just $ fileName file
|
||||
|
|
|
|||
13
Helper.hs
13
Helper.hs
|
|
@ -22,6 +22,7 @@ import Model
|
|||
import Data.Maybe
|
||||
import Data.List as L
|
||||
import qualified Data.ByteString as B
|
||||
import qualified Data.ByteString.Char8 as C
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.Text as T
|
||||
import Data.Time
|
||||
|
|
@ -35,6 +36,10 @@ import Network.Mail.Mime
|
|||
import Text.Blaze.Html.Renderer.Utf8
|
||||
import Graphics.ImageMagick.MagickWand
|
||||
import Filesystem.Path.CurrentOS
|
||||
import Database.Bloodhound
|
||||
import Network.HTTP.Client
|
||||
import Network.HTTP.Types.Status as S
|
||||
import Control.Monad (when)
|
||||
|
||||
getUserIdFromText :: T.Text -> UserId
|
||||
getUserIdFromText tempUserId =
|
||||
|
|
@ -53,6 +58,14 @@ extractKey = extractKey' . keyToValues
|
|||
extractKey' [PersistInt64 k] = T.pack $ show k
|
||||
extractKey' _ = ""
|
||||
|
||||
packKey :: PersistEntity record => T.Text -> Key record
|
||||
packKey = keyFromValues' . readText
|
||||
where
|
||||
readText t = PersistInt64 $ (fromIntegral $ read $ T.unpack t)
|
||||
keyFromValues' v = case keyFromValues [v] of
|
||||
Left err -> error $ T.unpack err
|
||||
Right k -> k
|
||||
|
||||
fromHex :: String -> BL.ByteString
|
||||
fromHex = BL.pack . hexToWords
|
||||
where hexToWords (c:c':text) =
|
||||
|
|
|
|||
174
Migrations/0.0.4-0.0.5/Migration.hs
Executable file
174
Migrations/0.0.4-0.0.5/Migration.hs
Executable file
|
|
@ -0,0 +1,174 @@
|
|||
module Migrate2 where
|
||||
|
||||
import Prelude
|
||||
import Database.HDBC
|
||||
import Database.HDBC.PostgreSQL
|
||||
import System.IO
|
||||
import Control.Exception
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.ByteString.Char8 as B
|
||||
import Data.Aeson as A
|
||||
import Data.Time.Clock
|
||||
import Data.Yaml as Y
|
||||
import Data.Time.LocalTime
|
||||
import Database.Bloodhound
|
||||
import Network.HTTP.Client
|
||||
|
||||
data ESSettings = ESSettings
|
||||
{ esHost :: T.Text
|
||||
, esShards :: Int
|
||||
, esReplicas :: Int
|
||||
}
|
||||
|
||||
instance A.FromJSON ESSettings where
|
||||
parseJSON = withObject "AppSettings" $ \o -> do
|
||||
esHost <- o .: "searchhost"
|
||||
esShards <- o .: "shards"
|
||||
esReplicas <- o .: "replicas"
|
||||
return ESSettings {..}
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
putStrLn "Enter database host"
|
||||
dbHost <- getLine
|
||||
putStrLn "Enter database port"
|
||||
dbPort <- getLine
|
||||
putStrLn "Enter database user"
|
||||
dbUser <- getLine
|
||||
putStrLn "Enter database name"
|
||||
dbName <- getLine
|
||||
putStrLn "Enter database password"
|
||||
dbPasswd <- getPasswd
|
||||
putStrLn "Enter location of eidolon settings.yml file"
|
||||
settingsFP <- getLine
|
||||
let dbString = "host=" ++ dbHost ++ " port=" ++ dbPort ++ " user=" ++ dbUser ++ " dbname=" ++ dbName ++ " password=" ++ dbPasswd
|
||||
conn <- connectPostgreSQL dbString
|
||||
settingsY <- decodeFile settingsFP :: IO (Maybe ESSettings)
|
||||
elastic <- case settingsY of
|
||||
Just el -> return el
|
||||
Nothing -> error $ "Could not read settings from " ++ settingsFP
|
||||
let server = Server $ esHost elastic
|
||||
let indexSettings = IndexSettings (ShardCount $ esShards elastic) (ReplicaCount $ esReplicas elastic)
|
||||
userStmt <- prepare conn "select * from \"user\""
|
||||
_ <- execute userStmt []
|
||||
userRows <- fetchAllRowsAL userStmt
|
||||
albumStmt <- prepare conn "select * from \"album\""
|
||||
_ <- execute albumStmt []
|
||||
albumRows <- fetchAllRowsAL albumStmt
|
||||
mediumStmt <- prepare conn "select * from \"medium\""
|
||||
_ <- execute mediumStmt []
|
||||
mediumRows <- fetchAllRowsAL mediumStmt
|
||||
commentStmt <- prepare conn "select * from \"comment\""
|
||||
_ <- execute commentStmt []
|
||||
commentRows <- fetchAllRowsAL commentStmt
|
||||
_ <- withBH defaultManagerSettings server $ do
|
||||
_ <- createIndex indexSettings (IndexName "user")
|
||||
_ <- createIndex indexSettings (IndexName "album")
|
||||
_ <- createIndex indexSettings (IndexName "medium")
|
||||
_ <- createIndex indexSettings (IndexName "comment")
|
||||
_ <- sequence $ map (\entry ->
|
||||
case entry of
|
||||
[("id", SqlInteger theId), ("name", SqlByteString name), ("slug", SqlByteString slug), _, _, _, _, _] -> do
|
||||
let u = SUser (bToT name) (bToT slug)
|
||||
let dId = DocId $ T.pack $ show theId
|
||||
indexDocument (IndexName "user") (MappingName "user") defaultIndexDocumentSettings u dId
|
||||
bla ->
|
||||
error $ "malformed entry" ++ show bla
|
||||
) userRows
|
||||
_ <- sequence $ map (\entry ->
|
||||
case entry of
|
||||
[("id", SqlInteger theId), ("title", SqlByteString title), _, _, _, _, _] -> do
|
||||
let a = SAlbum (bToT title)
|
||||
let dId = DocId $ T.pack $ show theId
|
||||
indexDocument (IndexName "album") (MappingName "album") defaultIndexDocumentSettings a dId
|
||||
bla ->
|
||||
error $ "malformed entry: " ++ show bla
|
||||
) albumRows
|
||||
_ <- sequence $ map (\entry ->
|
||||
case entry of
|
||||
[("id", SqlInteger theId), ("title", SqlByteString title), _, _, _, ("time", SqlZonedTime time), _, ("description", SqlByteString desc), ("tags", SqlByteString tags), _, _, _, _, _] -> do
|
||||
let m = SMedium (bToT title) (zonedTimeToUTC time) (bToT desc) (parseTags tags)
|
||||
let dId = DocId $ T.pack $ show theId
|
||||
indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings m dId
|
||||
bla ->
|
||||
error $ "malformed entry" ++ show bla
|
||||
) mediumRows
|
||||
_ <- sequence $ map (\entry ->
|
||||
case entry of
|
||||
[("id", SqlInteger theId), _, ("author_slug", SqlByteString author), _, _, ("time", SqlZonedTime time), ("content", SqlByteString content)] -> do
|
||||
let c = SComment (bToT author) (zonedTimeToUTC time) (bToT content)
|
||||
let dId = DocId $ T.pack $ show theId
|
||||
indexDocument (IndexName "medium") (MappingName "medium") defaultIndexDocumentSettings c dId
|
||||
bla ->
|
||||
error $ "malformed entry" ++ show bla
|
||||
) commentRows
|
||||
return ()
|
||||
putStrLn "Migration successful!!"
|
||||
|
||||
data SUser = SUser
|
||||
{ suName :: T.Text
|
||||
, suSlug :: T.Text
|
||||
}
|
||||
|
||||
instance A.ToJSON SUser where
|
||||
toJSON (SUser n s) = object
|
||||
[ "name" .= n
|
||||
, "slug" .= s
|
||||
]
|
||||
|
||||
data SAlbum = SAlbum
|
||||
{ saName :: T.Text }
|
||||
|
||||
instance A.ToJSON SAlbum where
|
||||
toJSON (SAlbum n) = object
|
||||
[ "name" .= n ]
|
||||
|
||||
data SMedium = SMedium
|
||||
{ smName :: T.Text
|
||||
, smTime :: UTCTime
|
||||
, smDesc :: T.Text
|
||||
, smTags :: [T.Text]
|
||||
}
|
||||
|
||||
instance A.ToJSON SMedium where
|
||||
toJSON (SMedium n t d g) = object
|
||||
[ "name" .= n
|
||||
, "time" .= t
|
||||
, "description" .= d
|
||||
, "tags" .= g
|
||||
]
|
||||
|
||||
data SComment = SComment
|
||||
{ scAuthor :: T.Text
|
||||
, scTime :: UTCTime
|
||||
, scContent :: T.Text
|
||||
}
|
||||
|
||||
instance A.ToJSON SComment where
|
||||
toJSON (SComment a t c) = object
|
||||
[ "author" .= a
|
||||
, "time" .= t
|
||||
, "content" .= c
|
||||
]
|
||||
|
||||
parseTags :: B.ByteString -> [T.Text]
|
||||
parseTags bs = map handle' inner
|
||||
where
|
||||
inner = T.splitOn "," $ T.pack $ B.unpack $ B.init $ B.tail bs
|
||||
handle' = T.dropEnd 2 . T.drop 3
|
||||
|
||||
bToT :: B.ByteString -> T.Text
|
||||
bToT = T.pack . B.unpack
|
||||
|
||||
getPasswd :: IO String
|
||||
getPasswd = do
|
||||
putStr "Password: "
|
||||
hFlush stdout
|
||||
pass <- withEcho False getLine
|
||||
putChar '\n'
|
||||
return pass
|
||||
|
||||
withEcho :: Bool -> IO a -> IO a
|
||||
withEcho echo action = do
|
||||
old <- hGetEcho stdin
|
||||
bracket_ (hSetEcho stdin echo) (hSetEcho stdin old) action
|
||||
87
Model.hs
87
Model.hs
|
|
@ -17,7 +17,7 @@
|
|||
module Model where
|
||||
|
||||
import ClassyPrelude.Yesod
|
||||
import Yesod.Markdown (Markdown)
|
||||
import Yesod.Markdown (Markdown, unMarkdown)
|
||||
import Database.Persist.Quasi
|
||||
import qualified System.FilePath as FP
|
||||
|
||||
|
|
@ -27,3 +27,88 @@ import qualified System.FilePath as FP
|
|||
-- http://www.yesodweb.com/book/persistent/
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"]
|
||||
$(persistFileWith lowerCaseSettings "config/models")
|
||||
|
||||
data ESInput = ESUser UserId User
|
||||
| ESAlbum AlbumId Album
|
||||
| ESMedium MediumId Medium
|
||||
| ESComment CommentId Comment
|
||||
|
||||
data FullUser = FullUser
|
||||
{userRep :: User}
|
||||
|
||||
instance ToJSON User where
|
||||
toJSON (User name slug _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= name
|
||||
, "slug" .= slug
|
||||
]
|
||||
|
||||
instance ToJSON FullUser where
|
||||
toJSON (FullUser user) =
|
||||
object
|
||||
[ "name" .= (userName user)
|
||||
, "slug" .= (userSlug user)
|
||||
, "albums" .= (userAlbums user)
|
||||
]
|
||||
|
||||
data FullAlbum = FullAlbum
|
||||
{albumRep :: Album}
|
||||
|
||||
instance ToJSON Album where
|
||||
toJSON (Album title _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= title ]
|
||||
|
||||
instance ToJSON FullAlbum where
|
||||
toJSON (FullAlbum album) =
|
||||
object
|
||||
[ "name" .= (albumTitle album)
|
||||
, "owner" .= (albumOwner album)
|
||||
, "shares" .= (albumShares album)
|
||||
, "content" .= (albumContent album)
|
||||
]
|
||||
|
||||
data FullMedium = FullMedium
|
||||
{mediumRep :: Medium}
|
||||
|
||||
instance ToJSON Medium where
|
||||
toJSON (Medium title _ _ _ time _ desc tags _ _ _ _ _) =
|
||||
object
|
||||
[ "name" .= title
|
||||
, "time" .= time
|
||||
, "description" .= desc
|
||||
, "tags" .= tags
|
||||
]
|
||||
|
||||
instance ToJSON FullMedium where
|
||||
toJSON (FullMedium medium) =
|
||||
object
|
||||
[ "name" .= (mediumTitle medium)
|
||||
, "time" .= (mediumTime medium)
|
||||
, "owner" .= (mediumOwner medium)
|
||||
, "description" .= (mediumDescription medium)
|
||||
, "tage" .= (mediumTags medium)
|
||||
, "album" .= (mediumAlbum medium)
|
||||
]
|
||||
|
||||
data FullComment = FullComment
|
||||
{commentRep :: Comment}
|
||||
|
||||
instance ToJSON Comment where
|
||||
toJSON (Comment _ slug _ _ time cont) =
|
||||
object
|
||||
[ "author" .= slug
|
||||
, "time" .= time
|
||||
, "content" .= (unMarkdown cont)
|
||||
]
|
||||
|
||||
instance ToJSON FullComment where
|
||||
toJSON (FullComment comment) =
|
||||
object
|
||||
[ "author_id" .= (commentAuthor comment)
|
||||
, "author" .= (commentAuthorSlug comment)
|
||||
, "origin" .= (commentOrigin comment)
|
||||
, "parent" .= (commentParent comment)
|
||||
, "time" .= (commentTime comment)
|
||||
, "content" .= (unMarkdown $ commentContent comment)
|
||||
]
|
||||
|
|
|
|||
22
README.md
22
README.md
|
|
@ -10,6 +10,8 @@ Visit the test instance at [eidolon.nek0.eu][eidolon]
|
|||
|
||||
###Dependencies
|
||||
|
||||
####Build dependencies
|
||||
|
||||
A working Haskell capable environment. For that you will need `haskell-stack` and `cabal-install`, which you can install with:
|
||||
|
||||
```bash
|
||||
|
|
@ -47,6 +49,15 @@ cabal install alex happy
|
|||
sudo apt-get install libmagick++-dev
|
||||
```
|
||||
|
||||
####Elasticsearch dependencies
|
||||
|
||||
Since version 0.0.5 there is an Elasticsearch integration for Eidolon. To Be able to run eidolon , you need to install `elasticsearch` additionally with:
|
||||
|
||||
```bash
|
||||
sudo apt-get install elasticsearch
|
||||
```
|
||||
On how to configure your elasticsearch server, look into the [elasticsearch documentation][elasticdocu].
|
||||
|
||||
###Building
|
||||
|
||||
get the source with
|
||||
|
|
@ -80,7 +91,7 @@ cabal build
|
|||
|
||||
After compiling you will find an executable called `eidolon` in `dist/build/eidolon/`. Copy or link it anywhere you want. The executable needs to be accompanied by the folders `config` and `static` and their contents. It's best to copy them to your desired destination.
|
||||
|
||||
Also check `config/settings.yml` and set the values there accrding to your configuration.
|
||||
Also check `config/settings.yml` and set the values there accrding to your configuration. Especially the settings for elasticsearch are vital.
|
||||
|
||||
It may also be necessery to create a reverse proxy to your gallery. I would recommend using [nginx](http://nginx.org/).
|
||||
|
||||
|
|
@ -105,6 +116,14 @@ Since eidolon will block your console, I recommend wrapping a init-script around
|
|||
* without sandbox: `runghc /path/to/eidolon/Migrations/0.0.3-0.0.4/Migration.hs`
|
||||
* start or restart your eidolon service
|
||||
|
||||
###0.0.4-0.0.5
|
||||
|
||||
* run migration script from your run location (where your `static` folder with all the images is located)
|
||||
* if you are building in a sandbox run `runghc -package-db/full/path/to/sandbox/XXX-ghc-version-packages.conf.d /path/to/eidolon/Migrations/0.0.4-0.0.5/Migration.hs`
|
||||
* Note: No space between the option `-package-db` and its argument
|
||||
* without sandbox: `runghc /path/to/eidolon/Migrations/0.0.4-0.0.5/Migration.hs`
|
||||
* start or restart your eidolon service
|
||||
|
||||
##Acknowledgements:
|
||||
|
||||
* This software uses the web Framework "Yesod" by Michael Snoyman. See more at: <http://www.yesodweb.com/>
|
||||
|
|
@ -113,3 +132,4 @@ Since eidolon will block your console, I recommend wrapping a init-script around
|
|||
|
||||
[eidolon]: http://eidolon.nek0.eu
|
||||
[stack]: https://github.com/commercialhaskell/stack/releases
|
||||
[elasticdocu]: https://www.elastic.co/guide/en/elasticsearch/reference/current/setup-configuration.html
|
||||
|
|
|
|||
|
|
@ -75,6 +75,10 @@ data AppSettings = AppSettings
|
|||
, appTos1 :: Text
|
||||
, appTos2 :: Text
|
||||
-- ^ Terms of Service
|
||||
, appSearchHost :: Text
|
||||
, appShards :: Int
|
||||
, appReplicas :: Int
|
||||
-- ^ Settings for Elasticsearch
|
||||
}
|
||||
|
||||
instance FromJSON AppSettings where
|
||||
|
|
@ -106,6 +110,10 @@ instance FromJSON AppSettings where
|
|||
appTos1 <- o .: "tos1"
|
||||
appTos2 <- o .: "tos2"
|
||||
|
||||
appSearchHost <- o .: "searchhost"
|
||||
appShards <- o .: "shards"
|
||||
appReplicas <- o .: "replicas"
|
||||
|
||||
return AppSettings {..}
|
||||
|
||||
-- | Settings for 'widgetFile', such as which template languages to support and
|
||||
|
|
|
|||
|
|
@ -70,3 +70,5 @@
|
|||
/feed/user/#UserId/rss.xml UserFeedRssR GET
|
||||
!/feed/user/#Text/atom.xml NameFeedAtomR GET
|
||||
!/feed/user/#Text/rss.xml NameFeedRssR GET
|
||||
|
||||
/search SearchR GET
|
||||
|
|
|
|||
|
|
@ -47,5 +47,12 @@ copyrightLink: https://github.com/nek0/eidolon
|
|||
|
||||
# block signup process
|
||||
signupBlocked: "_env:SIGNUP_BLOCK:false"
|
||||
|
||||
# Terms of Service
|
||||
tos1: "Terms of Service 1"
|
||||
tos2: "Terms of Service 2"
|
||||
|
||||
# Elasticsearcha settings
|
||||
searchhost: "http://localhost:9200"
|
||||
shards: 1
|
||||
replicas: 2
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
name: eidolon
|
||||
version: 0.0.4
|
||||
version: 0.0.5
|
||||
synopsis: Image gallery in Yesod
|
||||
homepage: https://eidolon.nek0.eu
|
||||
license: AGPL-3
|
||||
|
|
@ -50,6 +50,7 @@ library
|
|||
Handler.Tag
|
||||
Handler.RootFeed
|
||||
Handler.Commons
|
||||
Handler.Search
|
||||
|
||||
if flag(dev) || flag(library-only)
|
||||
cpp-options: -DDEVELOPMENT
|
||||
|
|
@ -114,6 +115,8 @@ library
|
|||
, wai >= 3.0
|
||||
, yesod-newsfeed >= 1.5
|
||||
, unix >= 2.7
|
||||
, bloodhound >= 0.8
|
||||
, http-types
|
||||
-- for Migrations
|
||||
, HDBC
|
||||
, HDBC-postgresql
|
||||
|
|
@ -122,6 +125,7 @@ library
|
|||
, filepath
|
||||
, system-filepath
|
||||
, bytestring
|
||||
, http-client
|
||||
|
||||
executable eidolon
|
||||
if flag(library-only)
|
||||
|
|
|
|||
|
|
@ -198,6 +198,16 @@
|
|||
|
||||
/*custom*/
|
||||
|
||||
#search > form
|
||||
{
|
||||
display: flex;
|
||||
}
|
||||
|
||||
#search > form .required > *
|
||||
{
|
||||
margin: 0;
|
||||
}
|
||||
|
||||
a:hover
|
||||
{
|
||||
color: black;
|
||||
|
|
@ -219,11 +229,22 @@
|
|||
padding: 1em 2em;
|
||||
}
|
||||
|
||||
#user-nav
|
||||
{
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
nav li
|
||||
{
|
||||
display: inline-block;
|
||||
}
|
||||
|
||||
#search
|
||||
{
|
||||
display: inline-block;
|
||||
float: right;
|
||||
}
|
||||
|
||||
.comment
|
||||
{
|
||||
border: 5px solid rgb(255, 255, 255);
|
||||
|
|
|
|||
|
|
@ -17,6 +17,8 @@
|
|||
$if block == False
|
||||
<li>
|
||||
<a href=@{SignupR}>Signup
|
||||
<div #search .right>
|
||||
^{pageBody searchWidget}
|
||||
|
||||
$maybe msg <- mmsg
|
||||
<div #message>#{msg}
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ $forall (Entity albumId album) <- userAlbs
|
|||
<a href=@{AlbumR albumId}>
|
||||
<figure class="thumbnail">
|
||||
$if (albumSamplePic album) == Nothing
|
||||
<img src=@{StaticR img_album_jpg}>
|
||||
<img src=@{StaticR img_album_jpg} title=#{albumTitle album}>
|
||||
$else
|
||||
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ fromJust $ albumSamplePic album) []} title=#{albumTitle album}>
|
||||
<figcaption>#{albumTitle album}
|
||||
|
|
|
|||
56
templates/result.hamlet
Executable file
56
templates/result.hamlet
Executable file
|
|
@ -0,0 +1,56 @@
|
|||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h1>
|
||||
Results for: #{query}
|
||||
|
||||
$if allEmpty
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h2>
|
||||
Sorry, no results
|
||||
$else
|
||||
$if not $ null userList
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h2>
|
||||
Results in Users:
|
||||
$forall (Entity uId user) <- userList
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<a href=@{ProfileR uId}>
|
||||
#{userSlug user}
|
||||
$if not $ null albumList
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h2>
|
||||
Results in Albums:
|
||||
$forall (Entity aId album) <- albumList
|
||||
<article .item data-width="#{albumSampleWidth album}">
|
||||
<a href=@{AlbumR aId}>
|
||||
<figure .thumbnail>
|
||||
$if (albumSamplePic album) == Nothing
|
||||
<img src=@{StaticR img_album_jpg} title=#{albumTitle album}>
|
||||
$else
|
||||
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ fromJust $ albumSamplePic album) []} title=#{albumTitle album}>
|
||||
<figcaption>#{albumTitle album}
|
||||
$if not $ null mediumList
|
||||
<article #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h2>
|
||||
Results in Media:
|
||||
$forall (Entity mId medium) <- mediumList
|
||||
<article .item data-width="#{mediumThumbWidth medium}">
|
||||
<a href=@{MediumR mId}>
|
||||
<figure .thumbnail>
|
||||
<img src=@{StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []} title=#{mediumTitle medium}>
|
||||
<figcaption>#{mediumTitle medium}
|
||||
$if not $ null commentList
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<h2>
|
||||
Results in Comments:
|
||||
$forall (Entity _ comment) <- commentList
|
||||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<a href=@{MediumR $ commentOrigin comment}>
|
||||
#{commentContent comment}
|
||||
5
templates/search.hamlet
Executable file
5
templates/search.hamlet
Executable file
|
|
@ -0,0 +1,5 @@
|
|||
<div #header .item data-width="400">
|
||||
<div .inner>
|
||||
<form method=GET action=@{SearchR}>
|
||||
^{widget}
|
||||
<input type="submit" value="Search">
|
||||
Loading…
Reference in a new issue