Vervis/src/Darcs/Local.hs

{- This file is part of Vervis.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Darcs.Local
    ( -- * Initialize new repo
      createRepo
      -- * View repo source
    , readPristineRoot
    )
where

import Prelude

import Storage.Hashed.Hash
import System.Directory (createDirectory)
import System.Exit (ExitCode (..))
import System.FilePath ((</>))
import System.IO (withFile, IOMode (ReadMode))
import System.Process (createProcess, proc, waitForProcess)

import qualified Data.ByteString as B

{-
initialRepoTree :: FileName -> DirTree B.ByteString
initialRepoTree repo =
    Dir repo
        [ Dir "_darcs"
            --[ File "format"
            --    "hashed|no-working-dir\n\
            --    \darcs-2"
            --, File "hashed_inventory" ""
            --, File "index" ???
            , Dir "inventories" []
            , Dir "patches" []
            , Dir "prefs" []
            --    [ File "binaries" ""
            --    , File "boring" ""
            --    , File "motd" ""
            --    ]
            , Dir "pristine.hashed" []
            ]
        ]
-}

-- | initialize a new bare repository at a specific location.
createRepo
    :: FilePath
    -- ^ Parent directory which already exists
    -> String
    -- ^ Name of new repo, i.e. new directory to create under the parent
    -> IO ()
createRepo parent name = do
    let path = parent </> name
    createDirectory path
    let settings = proc "darcs" ["init", "--no-working-dir", path]
    (_, _, _, ph) <- createProcess settings
    ec <- waitForProcess ph
    case ec of
        ExitSuccess   -> return ()
        ExitFailure n -> error $ "darcs init failed with exit code " ++ show n

{-data DirEntry = DirEntry
    { dentType :: ItemType
    , dentName :: Name
    , dentSize :: Maybe Int
    , dentHash :: Hash
    }

data DirEntryView = DirEntryView
    { devName    :: Name
    , devSize    :: Maybe Size
    , devHash    :: Hash
    , devContent :: Either BL.ByteString [DirEntry]
    }

data PathView
    = RootView [DirEntry]
    | TreeView Text Hash [DirEntry]
    | BlobView Text Hash BL.ByteString
-}

readPristineRoot :: FilePath -> IO (Maybe Int, Hash)
readPristineRoot darcsDir = do
    let inventoryFile = darcsDir </> "hashed_inventory"
    line <- withFile inventoryFile ReadMode B.hGetLine
    let hashBS = B.drop 9 line
    return (Nothing, decodeBase16 hashBS)

{-toDEnt :: (ItemType, Name, Maybe Int, Hash) -> DirEntry
toDEnt (it, n, ms, h) = DirEntry it n ms h

readSourceRootDir :: FilePath -> (Maybe Int, Hash) -> IO [DirEntry]
readSourceRootDir darcsDir (size, hash) =
    let pristineDir = darcsDir </> "pristine.hashed"
    in  map toDEnt <$> readDarcsHashedDir pristineDir (size, hash)

findDirEntry :: Name -> [DirEntry] -> Maybe DirEntry
findDirEntry name = find ((== name) . dentName)

viewDirEntry :: FilePath -> DirEntry -> IO DirEntryView
viewDirEntry pristineDir (DirEntry itype name size hash) = do
    content <- case itype of
        TreeType ->
        BlobType -> fmap decompress . readSegment . darcsLocation pristineDir
    return (name, size, hash, content)

textToName :: Text -> Name
textToName = Name . encodeUtf8

viewPath :: FilePath -> [Name] -> IO PathView
viewPath repoPath sourcePath = --TODO
-}