Items.hs

{-# LANGUAGE TupleSections, RecordWildCards, ScopedTypeVariables, PatternGuards, DeriveDataTypeable, GADTs #-}

module Output.Items(writeItems, lookupItem, listItems) where

import Control.Monad
import Data.List.Extra
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lazy.UTF8 as UTF8
import qualified Codec.Compression.GZip as GZip
import General.Str

import Input.Item
import General.Util
import General.Store
import General.Conduit


data Items a where Items :: Items BS.ByteString deriving Typeable


outputItem :: Target -> [String]
outputItem Target{..} =
    [if null targetURL then "." else targetURL
    ,maybe "." (joinPair " ") targetPackage
    ,maybe "." (joinPair " ") targetModule
    ,if null targetType then "." else targetType
    ,targetItem] ++
    replace [""] ["."] (lines targetDocs)

inputItem :: [String] -> Target
inputItem (url:pkg:modu:typ:self:docs) = targetExpandURL $
    Target (if url == "." then "" else url) (f pkg) (f modu) (if typ == "." then "" else typ) self (unlines $ replace ["."] [""] docs)
    where
        f "." = Nothing
        f x = Just (word1 x)

-- write all the URLs, docs and enough info to pretty print it to a result
-- and replace each with an identifier (index in the space) - big reduction in memory
writeItems :: StoreWrite -> (Conduit (Maybe Target, item) IO (Maybe TargetId, item) -> IO a) -> IO a
writeItems store act = act $ do
    void $ (\f -> mapAccumMC f 0) $ \pos (target, item) -> case target of
        Nothing -> return (pos, (Nothing, item))
        Just target -> do
            let bs = LBS.toStrict $ GZip.compress $ lstrPack $ unlines $ outputItem target
            liftIO $ do
                storeWritePart store Items $ intToBS $ BS.length bs
                storeWritePart store Items bs
            let pos2 = pos + fromIntegral (intSize + BS.length bs)
            return (pos2, (Just $ TargetId pos, item))


listItems :: StoreRead -> [Target]
listItems store = unfoldr f $ storeRead store Items
    where
        f x | BS.null x = Nothing
            | (n,x) <- BS.splitAt intSize x
            , n <- intFromBS n
            , (this,x) <- BS.splitAt n x
            = Just (inputItem $ lines $ UTF8.toString $ GZip.decompress $ LBS.fromChunks [this], x)


lookupItem :: StoreRead -> (TargetId -> Target)
lookupItem store =
    let x = storeRead store Items
    in \(TargetId i) ->
        let i2 = fromIntegral i
            n = intFromBS $ BS.take intSize $ BS.drop i2 x
        in inputItem $ lines $ UTF8.toString $ GZip.decompress $ LBS.fromChunks $ return $ BS.take n $ BS.drop (i2 + intSize) x