X-Git-Url: https://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FStorage%2FImpl.hs;h=8b3cbebcb562fa4ebd7cc6de4967794ce8fb07c4;hp=bedc9eaa2808d3142e5d4abf91cd00d724369401;hb=42f51754dea02201aececaacbf194d714cd58aaf;hpb=98fd1cb53a837a9bda7145544c34872acb13a634 diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs index bedc9ea..8b3cbeb 100644 --- a/Rakka/Storage/Impl.hs +++ b/Rakka/Storage/Impl.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE + OverloadedStrings + , UnicodeSyntax + #-} module Rakka.Storage.Impl ( getPage' , putPage' @@ -9,19 +13,23 @@ module Rakka.Storage.Impl , putAttachment' ) where - +import Control.Applicative import Control.Concurrent import Control.Concurrent.STM import Control.Exception import Control.Monad import Data.Maybe +import Data.Monoid.Unicode import Data.Set (Set) import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T import Data.Time import Network.HTTP.Lucu import Network.HTTP.Lucu.Utils import Network.URI import Prelude hiding (words) +import Prelude.Unicode import Rakka.Attachment import Rakka.Page import Rakka.Storage.DefaultPage @@ -188,52 +196,51 @@ syncIndex' index revFile repos mkDraft mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages) -searchIndex :: Database -> Condition -> IO SearchResult +searchIndex ∷ Database → Condition → IO SearchResult searchIndex index cond - = do (ids, hint) <- searchDatabase' index cond + = do (ids, hint) ← searchDatabase' index cond let (total, words) = parseHint hint - pages <- mapM (fromId words) ids + pages ← mapM (fromId words) ids return SearchResult { srTotal = total , srPages = pages } where - parseHint :: [(String, Int)] -> (Int, [String]) + parseHint ∷ [(Text, Int)] → (Int, [Text]) parseHint xs = let total = fromJust $ lookup "" xs - words = filter (/= "") $ map fst xs + words = filter ((¬) ∘ T.null) $ map fst xs in (total, words) - fromId :: [String] -> DocumentID -> IO HitPage + fromId ∷ [Text] → DocumentID → IO HitPage fromId words docId - = do uri <- getDocURI index docId - rev <- unsafeInterleaveIO $ - liftM (read . fromJust) - (getDocAttr index docId "rakka:revision") - lastMod <- unsafeInterleaveIO $ - liftM (zonedTimeToUTC . fromJust . parseW3CDateTime . fromJust) - (getDocAttr index docId "@mdate") - summary <- unsafeInterleaveIO $ - getDocAttr index docId "rakka:summary" - snippet <- unsafeInterleaveIO $ - do doc <- getDocument index docId [NoAttributes, NoKeywords] - sn <- makeSnippet doc words 300 80 80 - return (trim (== Boundary) $ map toFragment sn) - return HitPage { - hpPageName = decodePageName $ uriPath uri - , hpPageRev = rev - , hpLastMod = lastMod - , hpSummary = summary - , hpSnippet = snippet - } - - toFragment :: Either String (String, String) -> SnippetFragment - toFragment (Left "") = Boundary - toFragment (Left t) = NormalText t + = do uri ← getDocURI index docId + rev ← unsafeInterleaveIO $ + -- FIXME: use Data.Text.Read + read ∘ T.unpack ∘ fromJust + <$> getDocAttr index docId "rakka:revision" + lastMod ← unsafeInterleaveIO $ + zonedTimeToUTC ∘ fromJust ∘ parseW3CDateTime ∘ T.unpack ∘ fromJust + <$> getDocAttr index docId "@mdate" + summary ← unsafeInterleaveIO $ + getDocAttr index docId "rakka:summary" + snippet ← unsafeInterleaveIO $ + do doc ← getDocument index docId [NoAttributes, NoKeywords] + sn ← makeSnippet doc words 300 80 80 + pure (trim (≡ Boundary) $ map toFragment sn) + pure HitPage { + hpPageName = decodePageName $ uriPath uri + , hpPageRev = rev + , hpLastMod = lastMod + , hpSummary = summary + , hpSnippet = snippet + } + toFragment ∷ Either Text (Text, Text) -> SnippetFragment + toFragment (Left "" ) = Boundary + toFragment (Left t ) = NormalText t toFragment (Right (w, _)) = HighlightedWord w - updateIndex :: Database -> Repository -> (Page -> IO Document) @@ -249,11 +256,11 @@ updateIndex index repos mkDraft rev name case docIdM of Nothing -> return () Just docId -> do removeDocument index docId [CleaningRemove] - infoM logger ("Removed page " ++ name ++ " from the index") + infoM logger ("Removed page " ⊕ T.unpack name ⊕ " from the index") Just page -> do draft <- mkDraft page putDocument index draft [CleaningPut] - infoM logger ("Indexed page " ++ name ++ " of revision " ++ show (pageRevision page)) + infoM logger ("Indexed page " ⊕ T.unpack name ⊕ " of revision " ⊕ show (pageRevision page)) updateIndexRev :: FilePath -> (RevNum -> IO RevNum) -> IO ()