merge branch origin/master

[Rakka.git] / Rakka / Storage / Impl.hs

diff --git a/Rakka/Storage/Impl.hs b/Rakka/Storage/Impl.hs
index 304b8178384463fc05dd86eba72daa0035f2c2ea..55bda719f5f30190bfff48d2711ef4b63afd0593 100644 (file)
--- a/Rakka/Storage/Impl.hs
+++ b/Rakka/Storage/Impl.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    OverloadedStrings
+  , UnicodeSyntax
+  #-}

 module Rakka.Storage.Impl
     ( getPage'
     , putPage'
 module Rakka.Storage.Impl
     ( getPage'
     , putPage'


@@ -9,20 +13,24 @@ module Rakka.Storage.Impl
     , putAttachment'
     )
     where
     , putAttachment'
     )
     where

-
+import Control.Applicative

 import           Control.Concurrent
 import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad
 import           Data.Maybe
 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.Set (Set)
 import qualified Data.Set as S

+import Data.Text (Text)
+import qualified Data.Text as T

 import           Data.Time
 import qualified Data.Time.W3C as W3C
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
 import           Network.URI
 import           Prelude hiding (words)
 import           Data.Time
 import qualified Data.Time.W3C as W3C
 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
 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)
 
 
                mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages)
 
 

-searchIndex :: Database -> Condition -> IO SearchResult
+searchIndex ∷ Database → Condition → IO SearchResult

 searchIndex index cond
 searchIndex index cond

-    = do (ids, hint) <- searchDatabase' index cond
+    = do (ids, hint) ← searchDatabase' index cond

          let (total, words) = parseHint hint
          let (total, words) = parseHint hint

-         pages <- mapM (fromId words) ids
+         pages ← mapM (fromId words) ids

          return SearchResult {
                       srTotal = total
                     , srPages = pages
                     }
     where
          return SearchResult {
                       srTotal = total
                     , srPages = pages
                     }
     where

-      parseHint :: [(String, Int)] -> (Int, [String])
+      parseHint ∷ [(Text, Int)] → (Int, [Text])

       parseHint xs
           = let total = fromJust $ lookup "" xs
       parseHint xs
           = let total = fromJust $ lookup "" xs

-                words = filter (/= "") $ map fst xs
+                words = filter ((¬) ∘ T.null) $ map fst xs

             in
               (total, words)
 
             in
               (total, words)
 

-      fromId :: [String] -> DocumentID -> IO HitPage
+      fromId ∷ [Text] → DocumentID → IO HitPage

       fromId words docId
       fromId words docId

-          = do uri     <- getDocURI index docId
-               rev     <- unsafeInterleaveIO $
-                          liftM (read . fromJust)
-                                (getDocAttr index docId "rakka:revision")
-               lastMod <- unsafeInterleaveIO $
-                          liftM (zonedTimeToUTC . fromJust . W3C.parse . 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 ∘ W3C.parse ∘ 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
 
       toFragment (Right (w, _)) = HighlightedWord w
 

-

 updateIndex :: Database
             -> Repository
             -> (Page -> IO Document)
 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]
                      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]
            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 ()
 
 
 updateIndexRev :: FilePath -> (RevNum -> IO RevNum) -> IO ()