By | ~fr33domlover |
At | 2018-05-22 |
Title | Bring the code from darcs-rev |
Description |
Add file AUTHORS.md 0
Edit file AUTHORS.md 0 → 0
+ 1 fr33domlover <fr33domlover@riseup.net>
… … … … Add file CHANGELOG.md 0
Edit file CHANGELOG.md 0 → 0
+ 1 This file lists the user-visible interesting changes between releases. For a
+ 2 full list of changes to the source, see `darcs log`.
+ 3 + 4 + 5 + 6 darcs-lights 0.1 unreleased
+ 7 ==================================
+ 8 + 9 * First release
… … … … Add file COPYING 0
Edit file COPYING 0 → 0
+ 1 Creative Commons Legal Code
+ 2 + 3 CC0 1.0 Universal
+ 4 + 5 CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE
+ 6 LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN
+ 7 ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS
+ 8 INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES
+ 9 REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS
+ 10 PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM
+ 11 THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED
+ 12 HEREUNDER.
+ 13 + 14 Statement of Purpose
+ 15 + 16 The laws of most jurisdictions throughout the world automatically confer
+ 17 exclusive Copyright and Related Rights (defined below) upon the creator
+ 18 and subsequent owner(s) (each and all, an "owner") of an original work of
+ 19 authorship and/or a database (each, a "Work").
+ 20 + 21 Certain owners wish to permanently relinquish those rights to a Work for
+ 22 the purpose of contributing to a commons of creative, cultural and
+ 23 scientific works ("Commons") that the public can reliably and without fear
+ 24 of later claims of infringement build upon, modify, incorporate in other
+ 25 works, reuse and redistribute as freely as possible in any form whatsoever
+ 26 and for any purposes, including without limitation commercial purposes.
+ 27 These owners may contribute to the Commons to promote the ideal of a free
+ 28 culture and the further production of creative, cultural and scientific
+ 29 works, or to gain reputation or greater distribution for their Work in
+ 30 part through the use and efforts of others.
+ 31 + 32 For these and/or other purposes and motivations, and without any
+ 33 expectation of additional consideration or compensation, the person
+ 34 associating CC0 with a Work (the "Affirmer"), to the extent that he or she
+ 35 is an owner of Copyright and Related Rights in the Work, voluntarily
+ 36 elects to apply CC0 to the Work and publicly distribute the Work under its
+ 37 terms, with knowledge of his or her Copyright and Related Rights in the
+ 38 Work and the meaning and intended legal effect of CC0 on those rights.
+ 39 + 40 1. Copyright and Related Rights. A Work made available under CC0 may be
+ 41 protected by copyright and related or neighboring rights ("Copyright and
+ 42 Related Rights"). Copyright and Related Rights include, but are not
+ 43 limited to, the following:
+ 44 + 45 i. the right to reproduce, adapt, distribute, perform, display,
+ 46 communicate, and translate a Work;
+ 47 ii. moral rights retained by the original author(s) and/or performer(s);
+ 48 iii. publicity and privacy rights pertaining to a person's image or
+ 49 likeness depicted in a Work;
+ 50 iv. rights protecting against unfair competition in regards to a Work,
+ 51 subject to the limitations in paragraph 4(a), below;
+ 52 v. rights protecting the extraction, dissemination, use and reuse of data
+ 53 in a Work;
+ 54 vi. database rights (such as those arising under Directive 96/9/EC of the
+ 55 European Parliament and of the Council of 11 March 1996 on the legal
+ 56 protection of databases, and under any national implementation
+ 57 thereof, including any amended or successor version of such
+ 58 directive); and
+ 59 vii. other similar, equivalent or corresponding rights throughout the
+ 60 world based on applicable law or treaty, and any national
+ 61 implementations thereof.
+ 62 + 63 2. Waiver. To the greatest extent permitted by, but not in contravention
+ 64 of, applicable law, Affirmer hereby overtly, fully, permanently,
+ 65 irrevocably and unconditionally waives, abandons, and surrenders all of
+ 66 Affirmer's Copyright and Related Rights and associated claims and causes
+ 67 of action, whether now known or unknown (including existing as well as
+ 68 future claims and causes of action), in the Work (i) in all territories
+ 69 worldwide, (ii) for the maximum duration provided by applicable law or
+ 70 treaty (including future time extensions), (iii) in any current or future
+ 71 medium and for any number of copies, and (iv) for any purpose whatsoever,
+ 72 including without limitation commercial, advertising or promotional
+ 73 purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each
+ 74 member of the public at large and to the detriment of Affirmer's heirs and
+ 75 successors, fully intending that such Waiver shall not be subject to
+ 76 revocation, rescission, cancellation, termination, or any other legal or
+ 77 equitable action to disrupt the quiet enjoyment of the Work by the public
+ 78 as contemplated by Affirmer's express Statement of Purpose.
+ 79 + 80 3. Public License Fallback. Should any part of the Waiver for any reason
+ 81 be judged legally invalid or ineffective under applicable law, then the
+ 82 Waiver shall be preserved to the maximum extent permitted taking into
+ 83 account Affirmer's express Statement of Purpose. In addition, to the
+ 84 extent the Waiver is so judged Affirmer hereby grants to each affected
+ 85 person a royalty-free, non transferable, non sublicensable, non exclusive,
+ 86 irrevocable and unconditional license to exercise Affirmer's Copyright and
+ 87 Related Rights in the Work (i) in all territories worldwide, (ii) for the
+ 88 maximum duration provided by applicable law or treaty (including future
+ 89 time extensions), (iii) in any current or future medium and for any number
+ 90 of copies, and (iv) for any purpose whatsoever, including without
+ 91 limitation commercial, advertising or promotional purposes (the
+ 92 "License"). The License shall be deemed effective as of the date CC0 was
+ 93 applied by Affirmer to the Work. Should any part of the License for any
+ 94 reason be judged legally invalid or ineffective under applicable law, such
+ 95 partial invalidity or ineffectiveness shall not invalidate the remainder
+ 96 of the License, and in such case Affirmer hereby affirms that he or she
+ 97 will not (i) exercise any of his or her remaining Copyright and Related
+ 98 Rights in the Work or (ii) assert any associated claims and causes of
+ 99 action with respect to the Work, in either case contrary to Affirmer's
+ 100 express Statement of Purpose.
+ 101 + 102 4. Limitations and Disclaimers.
+ 103 + 104 a. No trademark or patent rights held by Affirmer are waived, abandoned,
+ 105 surrendered, licensed or otherwise affected by this document.
+ 106 b. Affirmer offers the Work as-is and makes no representations or
+ 107 warranties of any kind concerning the Work, express, implied,
+ 108 statutory or otherwise, including without limitation warranties of
+ 109 title, merchantability, fitness for a particular purpose, non
+ 110 infringement, or the absence of latent or other defects, accuracy, or
+ 111 the present or absence of errors, whether or not discoverable, all to
+ 112 the greatest extent permissible under applicable law.
+ 113 c. Affirmer disclaims responsibility for clearing rights of other persons
+ 114 that may apply to the Work or any use thereof, including without
+ 115 limitation any person's Copyright and Related Rights in the Work.
+ 116 Further, Affirmer disclaims responsibility for obtaining any necessary
+ 117 consents, permissions or other rights required for any use of the
+ 118 Work.
+ 119 d. Affirmer understands and acknowledges that Creative Commons is not a
+ 120 party to this document and has no duty or obligation with respect to
+ 121 this CC0 or use of the Work.
… … … … Add file README.md 0
Edit file README.md 0 → 0
+ 1 See the .cabal file for more info and link to project website the version
+ 2 control.
+ 3 + 4 This library is free software, and is committed to software freedom. It is
+ 5 released to the public domain using the CC0 Public Domain Dedication. For the
+ 6 boring "legal" details see the file `COPYING`.
+ 7 + 8 To build the library, run `stack build` in the repo directory. You may run
+ 9 `stack setup` first to install GHC. You can play with the library on the GHCi
+ 10 interactive interpreter via `stack repl`.
+ 11 + 12 The file `CHANGELOG.md` provides a friendly overview of the changes for each
+ 13 release.
… … … … Add file Setup.hs 0
Edit file Setup.hs 0 → 0
+ 1 import Distribution.Simple
+ 2 main = defaultMain
… … … … Add file _boring 0
Edit file _boring 0 → 0
+ 1 ^.stack-work(/|$)
… … … … Add file darcs-lights.cabal 0
Edit file darcs-lights.cabal 0 → 0
+ 1 name: darcs-lights
+ 2 version: 0.1
+ 3 synopsis: Some tools for working with Darcs repos
+ 4 description:
+ 5 The API is currently unstable and should be properly organized and
+ 6 documented. But otherwise, basically, this library is an API for working with
+ 7 Darcs repositories. It's a collection of tools I wrote for a repository
+ 8 hosting web application. It's not polished right now and doesn't have its own
+ 9 plan for a complete feature set. I just add stuff when I need it. But I hope
+ 10 to gradually polish and document it, and maybe it can even be useful somehow
+ 11 to the actual Darcs project.
+ 12 .
+ 13 In case you wonder how this library started, here's the story:
+ 14 .
+ 15 In 2016 I started working on a web application, and I wanted it to be able to
+ 16 display some info about Darcs repositories. To avoid having to run the
+ 17 @darcs@ program on every request, I went to the @darcs@ package to check if
+ 18 some functions from there could help me. All the complicated type stuff there
+ 19 scared me (and maybe still does haha), so I decided to try challenging myself
+ 20 a bit as a novice Haskeller and wrote a little Attoparsec parser that
+ 21 reads the information directly from the @_darcs/@ directory.
+ 22 homepage: https://dev.seek-together.space/s/fr33domlover/r/darcs-lights
+ 23 bug-reports: https://dev.seek-together.space/s/fr33domlover/p/vervis/t
+ 24 license: PublicDomain
+ 25 license-file: COPYING
+ 26 author: fr33domlover
+ 27 maintainer: fr33domlover@riseup.net
+ 28 copyright: ♡ Copying is an act of love. Please copy, reuse and share.
+ 29 category: Development, Darcs
+ 30 build-type: Simple
+ 31 extra-source-files:
+ 32 AUTHORS.md
+ 33 CHANGELOG.md
+ 34 COPYING
+ 35 README.md
+ 36 cabal-version: >=1.10
+ 37 + 38 source-repository head
+ 39 type: darcs
+ 40 location: https://dev.seek-together.space/s/fr33domlover/r/darcs-lights
+ 41 + 42 library
+ 43 exposed-modules: Development.Darcs.Internal.Hash.Codec
+ 44 , Development.Darcs.Internal.Hash.Types
+ 45 , Development.Darcs.Internal.Inventory.Parser
+ 46 , Development.Darcs.Internal.Inventory.Read
+ 47 , Development.Darcs.Internal.Inventory.Types
+ 48 , Development.Darcs.Internal.Patch
+ 49 , Development.Darcs.Internal.Patch.Types
+ 50 other-modules: Control.Applicative.Local
+ 51 , Data.Attoparsec.ByteString.Local
+ 52 , Data.ByteString.Local
+ 53 , Data.Text.UTF8.Local
+ 54 build-depends: attoparsec
+ 55 , base
+ 56 , base16-bytestring
+ 57 , bytestring
+ 58 , bytestring-lexing
+ 59 , cryptonite
+ 60 , filepath
+ 61 , memory
+ 62 , text
+ 63 , time
+ 64 , zlib
+ 65 hs-source-dirs: src
+ 66 default-language: Haskell2010
+ 67 ghc-options: -Wall
… … … … Add file src 0
Add file src/Control 0
Add file src/Control/Applicative 0
Add file src/Control/Applicative/Local.hs 0
Edit file src/Control/Applicative/Local.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Control.Applicative.Local
+ 17 ( atMost
+ 18 , atMost_
+ 19 , upTo
+ 20 , upTo_
+ 21 )
+ 22 where
+ 23 + 24 import Prelude
+ 25 + 26 import Control.Applicative
+ 27 + 28 -- | Apply action between zero and @n@ times, inclusive, and list the results.
+ 29 atMost :: Alternative f => Int -> f a -> f [a]
+ 30 atMost n action = go n
+ 31 where
+ 32 go n =
+ 33 if n <= 0
+ 34 then pure []
+ 35 else liftA2 (:) action (go $ n - 1) <|> pure []
+ 36 + 37 -- | Apply action between zero and @n@ times, inclusive, and discard results.
+ 38 atMost_ :: Alternative f => Int -> f a -> f ()
+ 39 atMost_ n action = go n
+ 40 where
+ 41 go n =
+ 42 if n <= 0
+ 43 then pure ()
+ 44 else action *> (go $ n - 1) <|> pure ()
+ 45 + 46 -- | Apply action between one and @n@ times, inclusive, and list the results.
+ 47 upTo :: Alternative f => Int -> f a -> f [a]
+ 48 upTo n action = liftA2 (:) action $ atMost n action
+ 49 + 50 -- | Apply action between one and @n@ times, inclusive, and discard results.
+ 51 upTo_ :: Alternative f => Int -> f a -> f ()
+ 52 upTo_ n action = action *> atMost_ n action
… … … … Add file src/Data 0
Add file src/Data/Attoparsec 0
Add file src/Data/Attoparsec/ByteString 0
Add file src/Data/Attoparsec/ByteString/Local.hs 0
Edit file src/Data/Attoparsec/ByteString/Local.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Data.Attoparsec.ByteString.Local
+ 17 ( parseFileIncremental
+ 18 , parseCompressedFileIncremental
+ 19 )
+ 20 where
+ 21 + 22 import Prelude
+ 23 + 24 import Codec.Compression.Zlib.Internal
+ 25 import Data.Attoparsec.ByteString
+ 26 import System.IO
+ 27 + 28 import qualified Data.ByteString as B (null, hGet)
+ 29 import qualified Data.ByteString.Lazy.Internal as BLI (defaultChunkSize)
+ 30 + 31 parseFileIncremental :: FilePath -> Parser a -> IO (Either String a)
+ 32 parseFileIncremental file parser =
+ 33 withBinaryFile file ReadMode $ \ h -> do
+ 34 let getChunk = B.hGet h BLI.defaultChunkSize
+ 35 go (Fail _remainder _contexts msg) = return $ Left msg
+ 36 go (Partial cont) = getChunk >>= go . cont
+ 37 go (Done _remainder value) = return $ Right value
+ 38 firstChunk <- getChunk
+ 39 let firstResult = parse parser firstChunk
+ 40 go firstResult
+ 41 + 42 parseCompressedFileIncremental
+ 43 :: Format
+ 44 -> DecompressParams
+ 45 -> FilePath
+ 46 -> Parser a
+ 47 -> IO (Either String a)
+ 48 parseCompressedFileIncremental format params file parser =
+ 49 withBinaryFile file ReadMode $ \ h -> do
+ 50 let getChunk = B.hGet h BLI.defaultChunkSize
+ 51 + 52 pGo _ (Fail _remainder _contexts msg) = return $ Left msg
+ 53 pGo f (Partial cont) = f cont
+ 54 pGo _ (Done _remainder value) = return $ Right value
+ 55 + 56 dGo pCont (DecompressInputRequired dCont) =
+ 57 getChunk >>= dCont >>= dGo pCont
+ 58 dGo pCont (DecompressOutputAvailable output next) =
+ 59 pGo (\ c -> next >>= dGo c) (pCont output)
+ 60 dGo pCont (DecompressStreamEnd remainder) =
+ 61 if B.null remainder
+ 62 then
+ 63 pGo
+ 64 ( const $
+ 65 return $
+ 66 Left "Parser wants input but there's none"
+ 67 )
+ 68 (pCont remainder)
+ 69 else return $ Left "Decompression ended with remainder"
+ 70 dGo pCont (DecompressStreamError err) =
+ 71 return $ Left $ show err
+ 72 + 73 dGo (parse parser) (decompressIO format params)
… … … … Add file src/Data/ByteString 0
Add file src/Data/ByteString/Local.hs 0
Edit file src/Data/ByteString/Local.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 {-# LANGUAGE CPP #-}
+ 17 + 18 module Data.ByteString.Local
+ 19 ( fromDecimal
+ 20 #if !(MIN_VERSION_bytestring(0,10,8))
+ 21 , stripPrefix
+ 22 #else
+ 23 , B.stripPrefix
+ 24 #endif
+ 25 )
+ 26 where
+ 27 + 28 import Prelude
+ 29 + 30 import Data.ByteString (ByteString)
+ 31 + 32 import qualified Data.ByteString as B
+ 33 + 34 -- | Given an ASCII string representing an integer in decimal, parse it and
+ 35 -- return the number. Return 'Nothing' on invalid digit chars and on an empty
+ 36 -- bytestring.
+ 37 --
+ 38 -- >>> fromDecimal "345"
+ 39 -- Just 345
+ 40 --
+ 41 -- >>> fromDecimal "a1b2c3"
+ 42 -- Nothing
+ 43 fromDecimal :: Num a => ByteString -> Maybe a
+ 44 fromDecimal s =
+ 45 if (not . B.null) s && B.all (\ b -> 48 <= b && b <= 57) s
+ 46 then Just $ B.foldl' (\ n b -> 10 * n + fromIntegral b - 48) 0 s
+ 47 else Nothing
+ 48 + 49 #if !(MIN_VERSION_bytestring(0,10,8))
+ 50 stripPrefix :: ByteString -> ByteString -> Maybe ByteString
+ 51 stripPrefix p b =
+ 52 if p `B.isPrefixOf` b
+ 53 then Just $ B.drop (B.length p) b
+ 54 else Nothing
+ 55 #endif
… … … … Add file src/Data/Text 0
Add file src/Data/Text/UTF8 0
Add file src/Data/Text/UTF8/Local.hs 0
Edit file src/Data/Text/UTF8/Local.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 -- | Utilities for conversion between 'Text' and UTF8-encoded 'ByteString'
+ 17 module Data.Text.UTF8.Local
+ 18 ( encode
+ 19 , decodeStrict
+ 20 , decodeLenient
+ 21 , encodeFilename
+ 22 , encodeSource
+ 23 , decodeFilename
+ 24 , decodeSource
+ 25 )
+ 26 where
+ 27 + 28 import Prelude ()
+ 29 + 30 import Data.ByteString (ByteString)
+ 31 import Data.Text (Text)
+ 32 + 33 import qualified Data.Text.Encoding as TE
+ 34 import qualified Data.Text.Encoding.Error as TEE
+ 35 + 36 encode :: Text -> ByteString
+ 37 encode = TE.encodeUtf8
+ 38 + 39 decodeStrict :: ByteString -> Text
+ 40 decodeStrict = TE.decodeUtf8With TEE.strictDecode
+ 41 + 42 decodeLenient :: ByteString -> Text
+ 43 decodeLenient = TE.decodeUtf8With TEE.lenientDecode
+ 44 + 45 -- | Encode text in a way appropriate for filenames. This is simply set to
+ 46 -- 'encode'.
+ 47 encodeFilename :: Text -> ByteString
+ 48 encodeFilename = encode
+ 49 + 50 -- | Encode text in a way appropriate for source content. This is simply set to
+ 51 -- 'encode'.
+ 52 encodeSource :: Text -> ByteString
+ 53 encodeSource = encode
+ 54 + 55 -- | Decode text in a way appropriate for filenames. Since these names may be
+ 56 -- used for reading and writing to the file system, errors here must not be
+ 57 -- ignored, therefore the conversion is strict.
+ 58 decodeFilename :: ByteString -> Text
+ 59 decodeFilename = decodeStrict
+ 60 + 61 -- | Encode text in a way appropriate for source content. Even in the case of
+ 62 -- an encoding error, the application shouldn't fail. It should still display
+ 63 -- the content, so that the valid parts are visible and the error too is
+ 64 -- visible to the user. Therefore the conversion is lenient.
+ 65 decodeSource :: ByteString -> Text
+ 66 decodeSource = decodeLenient
… … … … Add file src/Development 0
Add file src/Development/Darcs 0
Add file src/Development/Darcs/Internal 0
Add file src/Development/Darcs/Internal/Hash 0
Add file src/Development/Darcs/Internal/Hash/Codec.hs 0
Edit file src/Development/Darcs/Internal/Hash/Codec.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 {-# LANGUAGE OverloadedStrings #-}
+ 17 + 18 module Development.Darcs.Internal.Hash.Codec
+ 19 ( encodePatchHash
+ 20 , encodeInventoryHash
+ 21 )
+ 22 where
+ 23 + 24 import Data.ByteString (ByteString)
+ 25 import Data.Monoid ((<>))
+ 26 + 27 import qualified Data.ByteString as B (length, replicate)
+ 28 import qualified Data.ByteString.Base16 as B16 (encode)
+ 29 import qualified Data.ByteString.Lex.Integral as BX (packDecimal)
+ 30 + 31 import Development.Darcs.Internal.Hash.Types
+ 32 + 33 encodeHash :: ByteString -> ByteString
+ 34 encodeHash = B16.encode
+ 35 + 36 encodeSize :: Int -> ByteString
+ 37 encodeSize n =
+ 38 case BX.packDecimal n of
+ 39 Nothing -> error "negative size in sizehash"
+ 40 Just b ->
+ 41 if B.length b < 10
+ 42 then B.replicate (10 - B.length b) 0x30 <> b
+ 43 else b
+ 44 + 45 encodePatchHash :: PatchHash -> ByteString
+ 46 encodePatchHash (PatchHash h) = encodeHash h
+ 47 + 48 encodeInventoryHash :: InventoryHash -> ByteString
+ 49 encodeInventoryHash (InventoryHash s h) = encodeSize s <> "-" <> encodeHash h
… … … … Add file src/Development/Darcs/Internal/Hash/Types.hs 0
Edit file src/Development/Darcs/Internal/Hash/Types.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Development.Darcs.Internal.Hash.Types
+ 17 ( PatchHash (..)
+ 18 , ContentHash (..)
+ 19 , InventoryHash (..)
+ 20 , PristineHash (..)
+ 21 )
+ 22 where
+ 23 + 24 import Data.ByteString (ByteString)
+ 25 + 26 -- | A SHA1 hash of the patch info (author, title, description including junk,
+ 27 -- timestamp). The hash is in binary form, not hex, i.e. its size is always 20
+ 28 -- bytes.
+ 29 newtype PatchHash = PatchHash { unPatchHash :: ByteString }
+ 30 + 31 -- | Content size and SHA256 hash of a patch's info and content. The hash is in
+ 32 -- binary form, not hex, i.e. its size is always 32 bytes.
+ 33 data ContentHash = ContentHash
+ 34 { chSize :: Int
+ 35 , chHash :: ByteString
+ 36 }
+ 37 + 38 -- | Content size and SHA256 hash of an inventory (a patch set in a single
+ 39 -- invetory file). The hash is in binary form, not hex, i.e. its size is always
+ 40 -- 32 bytes.
+ 41 data InventoryHash = InventoryHash
+ 42 { ihSize :: Int
+ 43 , ihHash :: ByteString
+ 44 }
+ 45 + 46 -- | A SHA256 hash of the entire recorded state of the repo. The hash is in
+ 47 -- binary form, not hex, i.e. its size is always 32 bytes.
+ 48 newtype PristineHash = PristineHash { unPristineHash :: ByteString }
… … … … Add file src/Development/Darcs/Internal/Inventory 0
Add file src/Development/Darcs/Internal/Inventory/Parser.hs 0
Edit file src/Development/Darcs/Internal/Inventory/Parser.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 {-# LANGUAGE OverloadedStrings #-}
+ 17 + 18 -- We use the ByteString based Attoparsec and not the Text based one because we
+ 19 -- need to create a hash of the patch info. If we use the Text one, Attoparsec
+ 20 -- decodes the text, hopefully as UTF-8, and then we need to encode again to
+ 21 -- ByteString for the hashing. This is dangerous because if the encoding
+ 22 -- doesn't result with the exact original text, we'll have the wrong hash. To
+ 23 -- make sure it's exactly the right content, we use ByteString first and then
+ 24 -- later decode to Text.
+ 25 module Development.Darcs.Internal.Inventory.Parser
+ 26 ( latestInventoryPristineP
+ 27 , latestInventorySizeP
+ 28 , latestInventoryPrevSizeP
+ 29 , latestInventoryPageP
+ 30 , latestInventoryAllP
+ 31 , earlyInventorySizeP
+ 32 , earlyInventoryPrevSizeP
+ 33 , earlyInventoryPageP
+ 34 , earlyInventoryAllP
+ 35 )
+ 36 where
+ 37 + 38 import Prelude hiding (take, takeWhile)
+ 39 + 40 import Control.Applicative (many, optional, liftA2)
+ 41 import Control.Arrow (second)
+ 42 import Control.Monad (replicateM_)
+ 43 import Crypto.Hash
+ 44 import Data.Attoparsec.ByteString
+ 45 import Data.ByteArray (convert)
+ 46 import Data.ByteString (ByteString)
+ 47 import Data.Time.Calendar (fromGregorianValid)
+ 48 import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
+ 49 import Data.Word (Word8)
+ 50 + 51 import qualified Data.ByteString as B
+ 52 import qualified Data.ByteString.Char8 as BC
+ 53 import qualified Data.ByteString.Base16 as B16
+ 54 import qualified Data.ByteString.Lex.Integral as BX
+ 55 + 56 import Control.Applicative.Local
+ 57 import Development.Darcs.Internal.Hash.Types
+ 58 import Development.Darcs.Internal.Inventory.Types
+ 59 import Development.Darcs.Internal.Patch
+ 60 import Development.Darcs.Internal.Patch.Types
+ 61 import Data.Attoparsec.ByteString.Local
+ 62 import Data.ByteString.Local (stripPrefix)
+ 63 import Data.Text.UTF8.Local (decodeStrict)
+ 64 + 65 lf :: Word8
+ 66 lf = 10
+ 67 space :: Word8
+ 68 space = 32
+ 69 star :: Word8
+ 70 star = 42
+ 71 dash :: Word8
+ 72 dash = 45
+ 73 zero :: Word8
+ 74 zero = 48
+ 75 nine :: Word8
+ 76 nine = 57
+ 77 sqrOpen :: Word8
+ 78 sqrOpen = 91
+ 79 --sqrClose :: Word8
+ 80 --sqrClose = 93
+ 81 + 82 digit :: Parser Word8
+ 83 digit = satisfy $ \ w -> zero <= w && w <= nine
+ 84 + 85 digitP :: Num a => Parser a
+ 86 digitP = fmap (\ c -> fromIntegral $ c - zero) digit
+ 87 + 88 decimal2P :: Num a => Parser a
+ 89 decimal2P =
+ 90 (\ h l -> 10 * h + l) <$>
+ 91 digitP <*>
+ 92 digitP
+ 93 + 94 decimal4P :: Num a => Parser a
+ 95 decimal4P =
+ 96 (\ hh h l ll -> 10 * (10 * (10 * hh + h) + l) + ll) <$>
+ 97 digitP <*>
+ 98 digitP <*>
+ 99 digitP <*>
+ 100 digitP
+ 101 + 102 patchTimeP :: Parser UTCTime
+ 103 patchTimeP = do
+ 104 year <- decimal4P
+ 105 month <- decimal2P
+ 106 day <- decimal2P
+ 107 + 108 hours <- decimal2P
+ 109 minutes <- decimal2P
+ 110 seconds <- decimal2P
+ 111 + 112 case fromGregorianValid year month day of
+ 113 Nothing -> fail "Invalid patch date"
+ 114 Just uday -> return UTCTime
+ 115 { utctDay = uday
+ 116 , utctDayTime =
+ 117 secondsToDiffTime $ 3600 * hours + 60 * minutes + seconds
+ 118 }
+ 119 + 120 line :: Parser ByteString
+ 121 line = restOfLine
+ 122 + 123 restOfLine :: Parser ByteString
+ 124 restOfLine = takeWhile (/= lf)
+ 125 + 126 eol :: Parser ()
+ 127 eol = skip (== lf)
+ 128 + 129 skipLine :: Parser ()
+ 130 skipLine = skipWhile (/= lf)
+ 131 + 132 skipRestOfLine :: Parser ()
+ 133 skipRestOfLine = skipLine
+ 134 + 135 skipPatchP :: Parser ()
+ 136 skipPatchP =
+ 137 -- title
+ 138 skipLine *> eol *>
+ 139 -- author, inverted, time
+ 140 skipLine *> eol *>
+ 141 -- ignore, description
+ 142 (skipMany $ skip (== space) *> skipRestOfLine *> eol) *>
+ 143 -- end of info
+ 144 (string "] \n") *>
+ 145 -- hash
+ 146 skipLine
+ 147 + 148 sha256P :: Parser ByteString
+ 149 sha256P = do
+ 150 bs <- take 64
+ 151 case second B.null $ B16.decode bs of
+ 152 (h, True) -> return h
+ 153 _ -> fail "SHA256 decoding from hex failed"
+ 154 + 155 sizeP :: Parser Int
+ 156 sizeP = do
+ 157 bs <- take 10
+ 158 case second B.null <$> BX.readDecimal bs of
+ 159 Just (n, True) -> return n
+ 160 _ -> fail "sizeP failed"
+ 161 + 162 sizeSha256P :: Parser (Int, ByteString)
+ 163 sizeSha256P = liftA2 (,) sizeP (skip (== dash) *> sha256P)
+ 164 + 165 pristineP :: Parser PristineHash
+ 166 pristineP = string "pristine:" *> (PristineHash <$> sha256P)
+ 167 + 168 prevInvP :: Parser InventoryHash
+ 169 prevInvP =
+ 170 string "Starting with inventory" *> eol *>
+ 171 (uncurry InventoryHash <$> sizeSha256P)
+ 172 + 173 patchInfoRawP :: Parser PatchInfoRaw
+ 174 patchInfoRawP = do
+ 175 word8 sqrOpen
+ 176 title <- takeWhile1 (/= lf)
+ 177 eol
+ 178 + 179 author <- takeWhile1 (/= star)
+ 180 word8 star
+ 181 inverted <- (/= star) <$> (satisfy $ \ c -> c == star || c == dash)
+ 182 (timeRaw, time) <- match patchTimeP
+ 183 eol
+ 184 + 185 word8 space
+ 186 junkp <- string "Ignore-this: "
+ 187 junkc <- takeWhile1 (/= lf)
+ 188 eol
+ 189 + 190 lines <- many $ word8 space *> takeWhile (/= lf) <* eol
+ 191 string "] \nhash: "
+ 192 + 193 hash <- sizeSha256P
+ 194 + 195 return PatchInfoRaw
+ 196 { pirAuthor = author
+ 197 , pirHash = hash
+ 198 , pirTitle = title
+ 199 , pirDescription = lines
+ 200 , pirJunkPrefix = junkp
+ 201 , pirJunkContent = junkc
+ 202 , pirTime = (timeRaw, time)
+ 203 , pirInverted = inverted
+ 204 }
+ 205 + 206 -- TODO
+ 207 --
+ 208 -- * Finish DarcsRev code, make it build
+ 209 -- * Update darcs change view code to work correctly in the case of previous
+ 210 -- inventories, test vervis against libravatar for that
+ 211 + 212 -- | Parse patch metadata and compute the metadata's hash, which can be used as
+ 213 -- a patch identifier for lookup and matching.
+ 214 patchInfoP :: Parser (PatchInfo, PatchHash)
+ 215 patchInfoP = do
+ 216 pir <- patchInfoRawP
+ 217 return (refinePatchInfo pir, PatchHash $ convert $ hashPatchInfo SHA1 pir)
+ 218 + 219 tagInfoP :: Parser (TagInfo, PatchHash)
+ 220 tagInfoP = do
+ 221 (pi, ph) <- patchInfoP
+ 222 case patchToTag pi of
+ 223 Nothing -> fail "Expected a tag, got a patch that isn't a tag"
+ 224 Just ti -> return (ti, ph)
+ 225 + 226 -------------------------------------------------------------------------------
+ 227 -- Latest inventory
+ 228 -------------------------------------------------------------------------------
+ 229 + 230 latestInventoryPristineP :: Parser PristineHash
+ 231 latestInventoryPristineP = pristineP
+ 232 + 233 latestInventorySizeP :: Parser Int
+ 234 latestInventorySizeP =
+ 235 -- pristine hash
+ 236 skipLine *>
+ 237 -- previous inventory
+ 238 optional
+ 239 ( eol *> string "Starting" *> skipRestOfLine *>
+ 240 eol *> skipLine
+ 241 ) *>
+ 242 -- patch info
+ 243 (length <$> many (eol *> skipPatchP)) <*
+ 244 eol
+ 245 + 246 latestInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int)
+ 247 latestInventoryPrevSizeP =
+ 248 liftA2 (,)
+ 249 ( -- pristine hash
+ 250 skipLine *>
+ 251 -- previous inventory
+ 252 optional (eol *> prevInvP)
+ 253 )
+ 254 ( -- patch info
+ 255 (length <$> many (eol *> skipPatchP)) <*
+ 256 eol
+ 257 )
+ 258 + 259 latestInventoryPageP
+ 260 :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)])
+ 261 latestInventoryPageP off lim =
+ 262 let f mPrevTag pis =
+ 263 case mPrevTag of
+ 264 Nothing -> (Nothing, pis)
+ 265 Just (ih, pi) -> (Just ih, pi : pis)
+ 266 in liftA2 f
+ 267 -- pristine
+ 268 ( skipLine *>
+ 269 -- previous inventory and clean tag
+ 270 optional (liftA2 (,) (eol *> prevInvP) (eol *> patchInfoP)) <*
+ 271 -- skip offset
+ 272 replicateM_ off (eol *> skipPatchP)
+ 273 )
+ 274 -- take limit
+ 275 (atMost lim $ eol *> patchInfoP)
+ 276 + 277 latestInventoryAllP :: Parser LatestInventory
+ 278 latestInventoryAllP = LatestInventory
+ 279 <$> pristineP
+ 280 <*> optional (liftA2 (,) (eol *> prevInvP) (eol *> tagInfoP))
+ 281 <*> many (eol *> patchInfoP)
+ 282 <* eol
+ 283 + 284 -------------------------------------------------------------------------------
+ 285 -- Early inventory
+ 286 -------------------------------------------------------------------------------
+ 287 + 288 earlyInventorySizeP :: Parser Int
+ 289 earlyInventorySizeP =
+ 290 -- previous inventory
+ 291 optional
+ 292 ( string "Starting" *> skipRestOfLine *>
+ 293 eol *> skipLine
+ 294 ) *>
+ 295 -- patch info
+ 296 (length <$> many (eol *> skipPatchP)) <*
+ 297 eol
+ 298 + 299 earlyInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int)
+ 300 earlyInventoryPrevSizeP =
+ 301 liftA2 (,)
+ 302 -- previous inventory
+ 303 (optional $ prevInvP <* eol)
+ 304 -- patch info
+ 305 (length <$> many (skipPatchP *> eol))
+ 306 + 307 earlyInventoryPageP
+ 308 :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)])
+ 309 earlyInventoryPageP off lim =
+ 310 let f mPrevTag pis =
+ 311 case mPrevTag of
+ 312 Nothing -> (Nothing, pis)
+ 313 Just (ih, pi) -> (Just ih, pi : pis)
+ 314 in liftA2 f
+ 315 -- previous inventory and clean tag
+ 316 ( optional (liftA2 (,) (prevInvP <* eol) (patchInfoP <* eol)) <*
+ 317 -- skip offset
+ 318 replicateM_ off (skipPatchP *> eol)
+ 319 )
+ 320 -- take limit
+ 321 (atMost lim $ patchInfoP <* eol)
+ 322 + 323 earlyInventoryAllP :: Parser (Either EarliestInventory MiddleInventory)
+ 324 earlyInventoryAllP =
+ 325 let f Nothing pis = Left $ EarliestInventory pis
+ 326 f (Just (prev, ti)) pis = Right $ MiddleInventory prev ti pis
+ 327 in liftA2 f
+ 328 (optional $ liftA2 (,) (prevInvP <* eol) (tagInfoP <* eol))
+ 329 (many (patchInfoP <* eol))
+ 330 + 331 {-
+ 332 patchInfosOffsetP :: Int -> Parser PatchSeq
+ 333 patchInfosOffsetP off = PatchSeq
+ 334 <$> pristineP
+ 335 <*> optional (eol *> prevInvP)
+ 336 <*> ( replicateM_ off (eol *> skipPatchP) *>
+ 337 many (eol *> patchInfoP)
+ 338 )
+ 339 <* eol
+ 340 + 341 patchInfosLimitP :: Int -> Parser PatchSeq
+ 342 patchInfosLimitP lim = PatchSeq
+ 343 <$> pristineP
+ 344 <*> optional (eol *> prevInvP)
+ 345 <*> atMost lim (eol *> patchInfoP)
+ 346 -}
… … … … Add file src/Development/Darcs/Internal/Inventory/Read.hs 0
Edit file src/Development/Darcs/Internal/Inventory/Read.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Development.Darcs.Internal.Inventory.Read
+ 17 ( readLatestInventory
+ 18 , readCompressedInventory
+ 19 )
+ 20 where
+ 21 + 22 import Codec.Compression.Zlib.Internal
+ 23 import Control.Applicative (many, optional, liftA2)
+ 24 import Control.Arrow (second)
+ 25 import Control.Monad (replicateM_)
+ 26 import Crypto.Hash
+ 27 import Data.Attoparsec.ByteString
+ 28 import Data.ByteArray (convert)
+ 29 import Data.ByteString (ByteString)
+ 30 import Data.Time.Calendar (fromGregorianValid)
+ 31 import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
+ 32 import Data.Word (Word8)
+ 33 import System.FilePath ((</>))
+ 34 + 35 import qualified Data.ByteString as B
+ 36 import qualified Data.ByteString.Char8 as BC
+ 37 import qualified Data.ByteString.Base16 as B16
+ 38 import qualified Data.ByteString.Lex.Integral as BX
+ 39 + 40 import Control.Applicative.Local
+ 41 import Development.Darcs.Internal.Hash.Codec
+ 42 import Development.Darcs.Internal.Hash.Types
+ 43 import Development.Darcs.Internal.Inventory.Parser
+ 44 import Development.Darcs.Internal.Inventory.Types
+ 45 import Data.Attoparsec.ByteString.Local
+ 46 import Data.ByteString.Local (stripPrefix)
+ 47 import Data.Text.UTF8.Local (decodeStrict)
+ 48 + 49 darcsDir :: FilePath
+ 50 darcsDir = "_darcs"
+ 51 + 52 inventoryDir :: FilePath
+ 53 inventoryDir = "inventories"
+ 54 + 55 inventoryFile :: FilePath
+ 56 inventoryFile = "hashed_inventory"
+ 57 + 58 readLatestInventory :: FilePath -> Parser a -> IO (Either String a)
+ 59 readLatestInventory repo =
+ 60 parseFileIncremental $ repo </> darcsDir </> inventoryFile
+ 61 + 62 readCompressedInventory
+ 63 :: FilePath -> InventoryHash -> Parser a -> IO (Either String a)
+ 64 readCompressedInventory repo ih =
+ 65 let invFile = BC.unpack $ encodeInventoryHash ih
+ 66 invPath = repo </> darcsDir </> inventoryDir </> invFile
+ 67 defParams = defaultDecompressParams
+ 68 bufSize = min (decompressBufferSize defParams) (ihSize ih)
+ 69 params = defParams { decompressBufferSize = bufSize }
+ 70 in parseCompressedFileIncremental gzipFormat params invPath
+ 71 + 72 {-
+ 73 readLatestInventorySize :: FilePath -> IO (Either String Int)
+ 74 + 75 readLatestInventoryAll :: FilePath -> IO (Either String LatestInventory)
+ 76 + 77 readLatestInventoryPage
+ 78 :: Int -> Int -> FilePath -> IO (Either String LatestInventory)
+ 79 + 80 readInventorySize :: FilePath -> IO (Either String Int)
+ 81 readInventorySize repoPath = do
+ 82 let invPath = repoPath </> darcsDir </> inventoryFile
+ 83 parseFileIncremental invPath $ patchInfosCountP <* endOfInput
+ 84 + 85 readPatchInfoAll :: FilePath -> IO (Either String PatchSeq)
+ 86 readPatchInfoAll repoPath = do
+ 87 let invPath = repoPath </> darcsDir </> inventoryFile
+ 88 parseFileIncremental invPath $ patchInfosAllP <* endOfInput
+ 89 + 90 readPatchInfoPage :: Int -> Int -> FilePath -> IO (Either String PatchSeq)
+ 91 readPatchInfoPage off lim repoPath = do
+ 92 let invPath = repoPath </> darcsDir </> inventoryFile
+ 93 parseFileIncremental invPath $ patchInfosOffsetLimitP off lim
+ 94 -}
… … … … Add file src/Development/Darcs/Internal/Inventory/Types.hs 0
Edit file src/Development/Darcs/Internal/Inventory/Types.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Development.Darcs.Internal.Inventory.Types
+ 17 ( LatestInventory (..)
+ 18 , MiddleInventory (..)
+ 19 , EarliestInventory (..)
+ 20 )
+ 21 where
+ 22 + 23 -- TODO
+ 24 --
+ 25 -- Apparently, after a while, some of the patches are moved from
+ 26 -- hashed_inventory into the inventories/ dir. So the patch set contains more
+ 27 -- than one group. This means I need to extend my parser to cover this case.
+ 28 -- Sources for info about this thing:
+ 29 --
+ 30 -- * Darcs source code
+ 31 -- * Darcs wiki
+ 32 -- * Local Darcs repos I have
+ 33 --
+ 34 -- From Darcs source code:
+ 35 --
+ 36 -- > The patches in a repository are stored in chunks broken up at \"clean\"
+ 37 -- > tags. A tag is clean if the only patches before it in the current
+ 38 -- > repository ordering are ones that the tag depends on (either directly
+ 39 -- > or indirectly). Each chunk is stored in a separate inventory file on disk.
+ 40 -- >
+ 41 -- > A 'PatchSet' represents a repo's history as the list of patches since the
+ 42 -- > last clean tag, and then a list of patch lists each delimited by clean tags.
+ 43 -- >
+ 44 -- > A 'Tagged' is a single chunk of a 'PatchSet'. It has a 'PatchInfo'
+ 45 -- > representing a clean tag, the hash of the previous inventory (if it exists),
+ 46 -- > and the list of patches since that previous inventory.
+ 47 --
+ 48 -- Let's start with finding out the format of the binary inventories and
+ 49 -- parsing them.
+ 50 + 51 import Data.ByteString (ByteString)
+ 52 import Data.Text (Text)
+ 53 import Data.Time.Clock (UTCTime)
+ 54 + 55 import Development.Darcs.Internal.Hash.Types
+ 56 import Development.Darcs.Internal.Patch.Types
+ 57 + 58 data LatestInventory = LatestInventory
+ 59 { liPristineHash :: PristineHash
+ 60 , liPrevTag :: Maybe (InventoryHash, (TagInfo, PatchHash))
+ 61 , liPatches :: [(PatchInfo, PatchHash)]
+ 62 }
+ 63 + 64 data MiddleInventory = MiddleInventory
+ 65 { miPrevious :: InventoryHash
+ 66 , miTag :: (TagInfo, PatchHash)
+ 67 , miPatches :: [(PatchInfo, PatchHash)]
+ 68 }
+ 69 + 70 newtype EarliestInventory = EarliestInventory
+ 71 { eiPatches :: [(PatchInfo, PatchHash)]
+ 72 }
… … … … Add file src/Development/Darcs/Internal/Patch 0
Add file src/Development/Darcs/Internal/Patch.hs 0
Edit file src/Development/Darcs/Internal/Patch.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 {-# LANGUAGE OverloadedStrings #-}
+ 17 + 18 module Development.Darcs.Internal.Patch
+ 19 ( hashPatchInfo
+ 20 , refinePatchInfo
+ 21 , tagToPatch
+ 22 , patchToTag
+ 23 , patchToTag_
+ 24 )
+ 25 where
+ 26 + 27 import Prelude hiding (take, takeWhile)
+ 28 + 29 import Control.Applicative (many, optional, liftA2)
+ 30 import Control.Arrow (second)
+ 31 import Control.Monad (replicateM_)
+ 32 import Crypto.Hash
+ 33 import Data.Attoparsec.ByteString
+ 34 import Data.ByteArray (convert)
+ 35 import Data.ByteString (ByteString)
+ 36 import Data.Time.Calendar (fromGregorianValid)
+ 37 import Data.Time.Clock (UTCTime (..), secondsToDiffTime)
+ 38 import Data.Word (Word8)
+ 39 import System.FilePath ((</>))
+ 40 + 41 import qualified Data.ByteString as B
+ 42 import qualified Data.ByteString.Char8 as BC
+ 43 import qualified Data.ByteString.Base16 as B16
+ 44 import qualified Data.ByteString.Lex.Integral as BX
+ 45 + 46 import Control.Applicative.Local
+ 47 import Development.Darcs.Internal.Hash.Types
+ 48 import Development.Darcs.Internal.Inventory.Types
+ 49 import Development.Darcs.Internal.Patch.Types
+ 50 import Data.Attoparsec.ByteString.Local
+ 51 import Data.ByteString.Local (stripPrefix)
+ 52 import Data.Text.UTF8.Local (decodeStrict)
+ 53 + 54 hashPatchInfo :: HashAlgorithm a => a -> PatchInfoRaw -> Digest a
+ 55 hashPatchInfo _algo pir =
+ 56 let add = flip hashUpdate
+ 57 adds = flip hashUpdates
+ 58 in hashFinalize $
+ 59 add (if pirInverted pir then "t" else "f" :: ByteString) $
+ 60 adds (pirDescription pir) $
+ 61 add (pirJunkContent pir) $
+ 62 add (pirJunkPrefix pir) $
+ 63 add (fst $ pirTime pir) $
+ 64 add (pirAuthor pir) $
+ 65 add (pirTitle pir)
+ 66 hashInit
+ 67 + 68 refinePatchInfo :: PatchInfoRaw -> PatchInfo
+ 69 refinePatchInfo pir =
+ 70 let rtitle = pirTitle pir
+ 71 (title, tag) = case stripPrefix "TAG " rtitle of
+ 72 Nothing -> (rtitle, False)
+ 73 Just rest -> (rest, True)
+ 74 description = case pirDescription pir of
+ 75 [] -> Nothing
+ 76 l -> Just $ BC.unlines l
+ 77 in PatchInfo
+ 78 { piAuthor = decodeStrict $ pirAuthor pir
+ 79 , piHash = uncurry ContentHash $ pirHash pir
+ 80 , piTitle = decodeStrict title
+ 81 , piDescription = decodeStrict <$> description
+ 82 , piTag = tag
+ 83 , piTime = snd $ pirTime pir
+ 84 }
+ 85 + 86 tagToPatch :: TagInfo -> PatchInfo
+ 87 tagToPatch tag = PatchInfo
+ 88 { piAuthor = tiAuthor tag
+ 89 , piHash = tiHash tag
+ 90 , piTitle = tiTitle tag
+ 91 , piDescription = tiDescription tag
+ 92 , piTag = True
+ 93 , piTime = tiTime tag
+ 94 }
+ 95 + 96 patchToTag :: PatchInfo -> Maybe TagInfo
+ 97 patchToTag pi =
+ 98 if piTag pi
+ 99 then Just $ patchToTag_ pi
+ 100 else Nothing
+ 101 + 102 patchToTag_ :: PatchInfo -> TagInfo
+ 103 patchToTag_ patch = TagInfo
+ 104 { tiAuthor = piAuthor patch
+ 105 , tiHash = piHash patch
+ 106 , tiTitle = piTitle patch
+ 107 , tiDescription = piDescription patch
+ 108 , tiTime = piTime patch
+ 109 }
… … … … Add file src/Development/Darcs/Internal/Patch/Types.hs 0
Edit file src/Development/Darcs/Internal/Patch/Types.hs 0 → 0
+ 1 {- This file is part of darcs-lights.
+ 2 -
+ 3 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
+ 4 -
+ 5 - ♡ Copying is an act of love. Please copy, reuse and share.
+ 6 -
+ 7 - The author(s) have dedicated all copyright and related and neighboring
+ 8 - rights to this software to the public domain worldwide. This software is
+ 9 - distributed without any warranty.
+ 10 -
+ 11 - You should have received a copy of the CC0 Public Domain Dedication along
+ 12 - with this software. If not, see
+ 13 - <http://creativecommons.org/publicdomain/zero/1.0/>.
+ 14 -}
+ 15 + 16 module Development.Darcs.Internal.Patch.Types
+ 17 ( PatchInfoRaw (..)
+ 18 , PatchInfo (..)
+ 19 , TagInfo (..)
+ 20 )
+ 21 where
+ 22 + 23 import Data.ByteString (ByteString)
+ 24 import Data.Text (Text)
+ 25 import Data.Time.Clock (UTCTime)
+ 26 + 27 import Development.Darcs.Internal.Hash.Types (ContentHash)
+ 28 + 29 -- | Patch metadata in raw form. This is intended for accurate hashing of the
+ 30 -- patch info.
+ 31 data PatchInfoRaw = PatchInfoRaw
+ 32 { pirAuthor :: ByteString
+ 33 , pirHash :: (Int, ByteString)
+ 34 , pirTitle :: ByteString
+ 35 , pirDescription :: [ByteString]
+ 36 , pirJunkPrefix :: ByteString
+ 37 , pirJunkContent :: ByteString
+ 38 , pirTime :: (ByteString, UTCTime)
+ 39 , pirInverted :: Bool
+ 40 }
+ 41 + 42 -- | Patch metadata read from the inventory file.
+ 43 data PatchInfo = PatchInfo
+ 44 { -- | Author name and email
+ 45 piAuthor :: Text
+ 46 -- | Patch content hash
+ 47 , piHash :: ContentHash
+ 48 -- | Single message line
+ 49 , piTitle :: Text
+ 50 -- | Optional description, may contain several lines
+ 51 , piDescription :: Maybe Text
+ 52 -- | Whether this is a tag
+ 53 , piTag :: Bool
+ 54 -- | When the patch was recorded
+ 55 , piTime :: UTCTime
+ 56 }
+ 57 + 58 -- | Tag metadata read from the inventory file.
+ 59 data TagInfo = TagInfo
+ 60 { -- | Author name and email
+ 61 tiAuthor :: Text
+ 62 -- | Tag content hash
+ 63 , tiHash :: ContentHash
+ 64 -- | Single message line
+ 65 , tiTitle :: Text
+ 66 -- | Optional description, may contain several lines
+ 67 , tiDescription :: Maybe Text
+ 68 -- | When the tag was recorded
+ 69 , tiTime :: UTCTime
+ 70 }
… … … … Add file stack.yaml 0
Edit file stack.yaml 0 → 0
+ 1 # For more information, see:
+ 2 # http://docs.haskellstack.org/en/stable/yaml_configuration.html
+ 3 + 4 # Specifies the GHC version and set of packages available (e.g., lts-3.5,
+ 5 # nightly-2015-09-21, ghc-7.10.2)
+ 6 resolver: lts-10.10
+ 7 + 8 # Local packages, usually specified by relative directory name
+ 9 packages:
+ 10 - '.'
+ 11 + 12 # Packages to be pulled from upstream that are not in the resolver (e.g.,
+ 13 # acme-missiles-0.3)
+ 14 extra-deps: []
+ 15 + 16 # Override default flag values for local packages and extra-deps
+ 17 flags: {}
+ 18 + 19 # Extra package databases containing global packages
+ 20 extra-package-dbs: []
+ 21 + 22 # Control whether we use the GHC we find on the path
+ 23 # system-ghc: true
+ 24 + 25 # Require a specific version of stack, using version ranges
+ 26 # require-stack-version: -any # Default
+ 27 # require-stack-version: >= 1.0.0
+ 28 + 29 # Override the architecture used by stack
+ 30 # arch: i386
+ 31 # arch: x86_64
+ 32 + 33 # Extra directories used by stack for building
+ 34 # extra-include-dirs: [/path/to/dir]
+ 35 # extra-lib-dirs: [/path/to/dir]
+ 36 + 37 # Allow a newer minor version of GHC than the snapshot specifies
+ 38 # compiler-check: newer-minor
… … … … Add file Pref 0
+ 1 changepref boringfile _boring