{-# 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 -> [String]
outputItem Target{String
Maybe (String, String)
targetDocs :: Target -> String
targetItem :: Target -> String
targetType :: Target -> String
targetModule :: Target -> Maybe (String, String)
targetPackage :: Target -> Maybe (String, String)
targetURL :: Target -> String
targetDocs :: String
targetItem :: String
targetType :: String
targetModule :: Maybe (String, String)
targetPackage :: Maybe (String, String)
targetURL :: String
..} =
    [if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
targetURL then String
"." else String
targetURL
    ,String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"." (String -> (String, String) -> String
forall a. [a] -> ([a], [a]) -> [a]
joinPair String
" ") Maybe (String, String)
targetPackage
    ,String
-> ((String, String) -> String) -> Maybe (String, String) -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"." (String -> (String, String) -> String
forall a. [a] -> ([a], [a]) -> [a]
joinPair String
" ") Maybe (String, String)
targetModule
    ,if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
targetType then String
"." else String
targetType
    ,String
targetItem] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
    [String] -> [String] -> [String] -> [String]
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace [String
""] [String
"."] (String -> [String]
lines String
targetDocs)

inputItem :: [String] -> Target
inputItem :: [String] -> Target
inputItem (String
url:String
pkg:String
modu:String
typ:String
self:[String]
docs) = Target -> Target
targetExpandURL (Target -> Target) -> Target -> Target
forall a b. (a -> b) -> a -> b
$
    String
-> Maybe (String, String)
-> Maybe (String, String)
-> String
-> String
-> String
-> Target
Target (if String
url String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." then String
"" else String
url) (String -> Maybe (String, String)
f String
pkg) (String -> Maybe (String, String)
f String
modu) (if String
typ String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"." then String
"" else String
typ) String
self ([String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [String] -> [String]
forall a. (Partial, Eq a) => [a] -> [a] -> [a] -> [a]
replace [String
"."] [String
""] [String]
docs)
    where
        f :: String -> Maybe (String, String)
f String
"." = Maybe (String, String)
forall a. Maybe a
Nothing
        f String
x = (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just ((String, String) -> Maybe (String, String))
-> (String, String) -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ String -> (String, String)
word1 String
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 -> (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO () -> IO a) -> IO a
writeItems :: StoreWrite
-> (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
    -> IO a)
-> IO a
writeItems StoreWrite
store ConduitM (Maybe Target, item) (Maybe TargetId, item) IO () -> IO a
act = ConduitM (Maybe Target, item) (Maybe TargetId, item) IO () -> IO a
act (ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
 -> IO a)
-> ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
-> IO a
forall a b. (a -> b) -> a -> b
$ do
    ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32
-> ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32
 -> ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ())
-> ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32
-> ConduitM (Maybe Target, item) (Maybe TargetId, item) IO ()
forall a b. (a -> b) -> a -> b
$ (\Word32
-> (Maybe Target, item) -> IO (Word32, (Maybe TargetId, item))
f -> (Word32
 -> (Maybe Target, item) -> IO (Word32, (Maybe TargetId, item)))
-> Word32
-> ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32
forall (m :: * -> *) t1 t2 b.
Monad m =>
(t1 -> t2 -> m (t1, b)) -> t1 -> ConduitT t2 b m t1
mapAccumMC Word32
-> (Maybe Target, item) -> IO (Word32, (Maybe TargetId, item))
f Word32
0) ((Word32
  -> (Maybe Target, item) -> IO (Word32, (Maybe TargetId, item)))
 -> ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32)
-> (Word32
    -> (Maybe Target, item) -> IO (Word32, (Maybe TargetId, item)))
-> ConduitT (Maybe Target, item) (Maybe TargetId, item) IO Word32
forall a b. (a -> b) -> a -> b
$ \Word32
pos (Maybe Target
target, item
item) -> case Maybe Target
target of
        Maybe Target
Nothing -> (Word32, (Maybe TargetId, item))
-> IO (Word32, (Maybe TargetId, item))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
pos, (Maybe TargetId
forall a. Maybe a
Nothing, item
item))
        Just Target
target -> do
            let bs :: ByteString
bs = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
GZip.compress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
lbstrPack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Target -> [String]
outputItem Target
target
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                StoreWrite -> Items ByteString -> ByteString -> IO ()
forall (t :: * -> *) a.
(Typeable (t a), Typeable a, Stored a) =>
StoreWrite -> t a -> a -> IO ()
storeWritePart StoreWrite
store Items ByteString
Items (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ByteString
intToBS (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs
                StoreWrite -> Items ByteString -> ByteString -> IO ()
forall (t :: * -> *) a.
(Typeable (t a), Typeable a, Stored a) =>
StoreWrite -> t a -> a -> IO ()
storeWritePart StoreWrite
store Items ByteString
Items ByteString
bs
            let pos2 :: Word32
pos2 = Word32
pos Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
intSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ByteString -> Int
BS.length ByteString
bs)
            (Word32, (Maybe TargetId, item))
-> IO (Word32, (Maybe TargetId, item))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word32
pos2, (TargetId -> Maybe TargetId
forall a. a -> Maybe a
Just (TargetId -> Maybe TargetId) -> TargetId -> Maybe TargetId
forall a b. (a -> b) -> a -> b
$ Word32 -> TargetId
TargetId Word32
pos, item
item))


listItems :: StoreRead -> [Target]
listItems :: StoreRead -> [Target]
listItems StoreRead
store = (ByteString -> Maybe (Target, ByteString))
-> ByteString -> [Target]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr ByteString -> Maybe (Target, ByteString)
f (ByteString -> [Target]) -> ByteString -> [Target]
forall a b. (a -> b) -> a -> b
$ StoreRead -> Items ByteString -> ByteString
forall (t :: * -> *) a.
(Typeable (t a), Typeable a, Stored a) =>
StoreRead -> t a -> a
storeRead StoreRead
store Items ByteString
Items
    where
        f :: ByteString -> Maybe (Target, ByteString)
f ByteString
x | ByteString -> Bool
BS.null ByteString
x = Maybe (Target, ByteString)
forall a. Maybe a
Nothing
            | (ByteString
n,ByteString
x) <- Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
intSize ByteString
x
            , Int
n <- ByteString -> Int
intFromBS ByteString
n
            , (ByteString
this,ByteString
x) <- Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n ByteString
x
            = (Target, ByteString) -> Maybe (Target, ByteString)
forall a. a -> Maybe a
Just ([String] -> Target
inputItem ([String] -> Target) -> [String] -> Target
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
UTF8.toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
GZip.decompress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
LBS.fromChunks [ByteString
this], ByteString
x)


lookupItem :: StoreRead -> (TargetId -> Target)
lookupItem :: StoreRead -> TargetId -> Target
lookupItem StoreRead
store =
    let x :: ByteString
x = StoreRead -> Items ByteString -> ByteString
forall (t :: * -> *) a.
(Typeable (t a), Typeable a, Stored a) =>
StoreRead -> t a -> a
storeRead StoreRead
store Items ByteString
Items
    in \(TargetId Word32
i) ->
        let i2 :: Int
i2 = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i
            n :: Int
n = ByteString -> Int
intFromBS (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
intSize (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
i2 ByteString
x
        in [String] -> Target
inputItem ([String] -> Target) -> [String] -> Target
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ ByteString -> String
UTF8.toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
GZip.decompress (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
LBS.fromChunks ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
n (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
i2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
intSize) ByteString
x