diff options
author | Joe Crayne <joe@jerkface.net> | 2018-10-23 23:05:23 -0400 |
---|---|---|
committer | Joe Crayne <joe@jerkface.net> | 2018-10-23 23:05:23 -0400 |
commit | 59af31ffa1f8c67aeb6f153c627c4edad4ceacd0 (patch) | |
tree | 0447780fbc91806afc6102bc36da1d3f64c5facd | |
parent | 16c3d897aec3e772abdfacdac8943f23a4a9353c (diff) |
Forgot to commit module XDelta.Types
-rw-r--r-- | haskell/XDelta/Types.hsc | 203 |
1 files changed, 203 insertions, 0 deletions
diff --git a/haskell/XDelta/Types.hsc b/haskell/XDelta/Types.hsc new file mode 100644 index 0000000..7bb648a --- /dev/null +++ b/haskell/XDelta/Types.hsc | |||
@@ -0,0 +1,203 @@ | |||
1 | {-# LANGUAGE BangPatterns #-} | ||
2 | {-# LANGUAGE GADTs #-} | ||
3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
4 | {-# LANGUAGE LambdaCase #-} | ||
5 | {-# LANGUAGE PatternSynonyms #-} | ||
6 | module XDelta.Types where | ||
7 | |||
8 | import Control.Exception | ||
9 | import Control.Monad | ||
10 | import Data.Bits | ||
11 | import qualified Data.ByteString as B | ||
12 | import qualified Data.ByteString.Internal as B | ||
13 | import Data.Function | ||
14 | import Data.Int | ||
15 | import Data.Monoid | ||
16 | import Data.Primitive.ByteArray | ||
17 | import qualified Data.Text as T | ||
18 | import Data.Text.Encoding | ||
19 | import Data.Word | ||
20 | import Foreign.C.String | ||
21 | import Foreign.C.Types | ||
22 | import Foreign.ForeignPtr | ||
23 | import Foreign.Marshal.Alloc | ||
24 | import Foreign.Marshal.Utils | ||
25 | import Foreign.Ptr | ||
26 | import Foreign.Storable | ||
27 | import System.IO | ||
28 | import System.IO.Error | ||
29 | import System.IO.Unsafe | ||
30 | |||
31 | |||
32 | |||
33 | #ifndef SIZEOF_SIZE_T | ||
34 | #define SIZEOF_SIZE_T __SIZEOF_SIZE_T__ | ||
35 | #define SIZEOF_UNSIGNED_INT __SIZEOF_INT__ | ||
36 | #define SIZEOF_UNSIGNED_LONG __SIZEOF_LONG__ | ||
37 | #define SIZEOF_UNSIGNED_LONG_LONG __SIZEOF_LONG_LONG__ | ||
38 | #define static_assert(...) | ||
39 | #endif | ||
40 | #include <xdelta3.h> | ||
41 | |||
42 | type Usize_t = #type usize_t | ||
43 | -- | Printf code for type Usize_t | ||
44 | pattern W :: String | ||
45 | pattern W = #const_str W "" | ||
46 | |||
47 | type Xoff_t = #type xoff_t | ||
48 | -- | Printf code for type Xoff_t | ||
49 | pattern Q :: String | ||
50 | pattern Q = #const_str Q "" | ||
51 | |||
52 | |||
53 | -- | These are the five ordinary status codes returned by the | ||
54 | -- xd3_encode_input() and xd3_decode_input() state machines. | ||
55 | -- | ||
56 | -- An application must be prepared to handle these five return | ||
57 | -- values from either xd3_encode_input or xd3_decode_input except | ||
58 | -- in the case of no-source compression in which case XD3_GETSRCBLK | ||
59 | -- is never returned. More detailed comments for these are given in | ||
60 | -- xd3_encode_input and xd3_decode_input comments below. | ||
61 | newtype ErrorCode = ErrorCode CInt | ||
62 | deriving Show | ||
63 | |||
64 | pattern XD3_SUCCESS = ErrorCode 0 | ||
65 | |||
66 | -- | need input | ||
67 | pattern XD3_INPUT = ErrorCode (#const XD3_INPUT) | ||
68 | |||
69 | -- | have output | ||
70 | pattern XD3_OUTPUT = ErrorCode (#const XD3_OUTPUT) | ||
71 | |||
72 | -- | need a block of source input (with no xd3_getblk function) a chance to do non-blocking read. | ||
73 | pattern XD3_GETSRCBLK = ErrorCode (#const XD3_GETSRCBLK) | ||
74 | |||
75 | -- | (decode-only) after the initial VCDIFF & first window header | ||
76 | pattern XD3_GOTHEADER = ErrorCode (#const XD3_GOTHEADER) | ||
77 | |||
78 | -- | notification: returned before a window is processed giving a chance to XD3_SKIP_WINDOW or not XD3_SKIP_EMIT that window. | ||
79 | pattern XD3_WINSTART = ErrorCode (#const XD3_WINSTART) | ||
80 | |||
81 | -- | notification: returned after encode/decode & output for a window | ||
82 | pattern XD3_WINFINISH = ErrorCode (#const XD3_WINFINISH) | ||
83 | |||
84 | -- | (encoder only) may be returned by getblk() if the block is too old | ||
85 | pattern XD3_TOOFARBACK = ErrorCode (#const XD3_TOOFARBACK) | ||
86 | |||
87 | -- | internal error | ||
88 | pattern XD3_INTERNAL = ErrorCode (#const XD3_INTERNAL) | ||
89 | |||
90 | -- | invalid config | ||
91 | pattern XD3_INVALID = ErrorCode (#const XD3_INVALID) | ||
92 | |||
93 | -- | invalid input/decoder error | ||
94 | pattern XD3_INVALID_INPUT = ErrorCode (#const XD3_INVALID_INPUT) | ||
95 | |||
96 | -- | when secondary compression finds no improvement. | ||
97 | pattern XD3_NOSECOND = ErrorCode (#const XD3_NOSECOND) | ||
98 | |||
99 | -- | currently VCD_TARGET VCD_CODETABLE | ||
100 | pattern XD3_UNIMPLEMENTED = ErrorCode (#const XD3_UNIMPLEMENTED) | ||
101 | |||
102 | instance Exception ErrorCode | ||
103 | |||
104 | data Config = Config | ||
105 | { winsize :: Usize_t -- ^ The encoder window size. | ||
106 | -- The encoder allocates a buffer of this size if the | ||
107 | -- program supplies input in smaller units (unless the | ||
108 | -- XD3_FLUSH flag is set). | ||
109 | , sprevsz :: Usize_t -- ^ How far back small string matching goes | ||
110 | , iopt_size :: Usize_t -- ^ entries in the instruction-optimizing buffer | ||
111 | , flags :: Flags -- ^ stream->flags are initialized from xd3_config & never modified by the library. Use xd3_set_flags to modify flags settings mid-stream. | ||
112 | , sec_data :: CompressorConfig -- ^ Secondary compressor config: data | ||
113 | , sec_inst :: CompressorConfig -- ^ Secondary compressor config: inst | ||
114 | , sec_addr :: CompressorConfig -- ^ Secondary compressor config: addr | ||
115 | , smatch_cfg :: Either StringMatcher SMatchSelect -- ^ See enum: use fields below for soft config | ||
116 | } | ||
117 | |||
118 | newtype Flags = Flags Word32 | ||
119 | deriving (Storable,Eq,Bits,FiniteBits) | ||
120 | |||
121 | -- used by VCDIFF tools, see xdelta3-main.h.--/ | ||
122 | pattern XD3_JUST_HDR = Flags (#const XD3_JUST_HDR) | ||
123 | -- used by VCDIFF tools see xdelta3-main.h.--/ | ||
124 | pattern XD3_SKIP_WINDOW = Flags (#const XD3_SKIP_WINDOW) | ||
125 | -- | used by VCDIFF tools, see xdelta3-main.h. */ | ||
126 | pattern XD3_SKIP_EMIT = Flags (#const XD3_SKIP_EMIT) | ||
127 | -- | flush the stream buffer to prepare for xd3_stream_close(). */ | ||
128 | pattern XD3_FLUSH = Flags (#const XD3_FLUSH) | ||
129 | -- | use DJW static huffman */ | ||
130 | pattern XD3_SEC_DJW = Flags (#const XD3_SEC_DJW) | ||
131 | -- | use FGK adaptive huffman */ | ||
132 | pattern XD3_SEC_FGK = Flags (#const XD3_SEC_FGK) | ||
133 | -- | use LZMA secondary */ | ||
134 | pattern XD3_SEC_LZMA = Flags (#const XD3_SEC_LZMA) | ||
135 | pattern XD3_SEC_TYPE = Flags (#const XD3_SEC_TYPE) | ||
136 | -- | disable secondary compression of the data section. */ | ||
137 | pattern XD3_SEC_NODATA = Flags (#const XD3_SEC_NODATA) | ||
138 | -- | disable secondary compression of the inst section. */ | ||
139 | pattern XD3_SEC_NOINST = Flags (#const XD3_SEC_NOINST) | ||
140 | -- | disable secondary compression of the addr section. */ | ||
141 | pattern XD3_SEC_NOADDR = Flags (#const XD3_SEC_NOADDR) | ||
142 | pattern XD3_SEC_NOALL = Flags (#const XD3_SEC_NOALL) | ||
143 | -- | enable checksum computation in the encoder. */ | ||
144 | pattern XD3_ADLER32 = Flags (#const XD3_ADLER32) | ||
145 | -- | disable checksum verification in the decoder. */ | ||
146 | pattern XD3_ADLER32_NOVER = Flags (#const XD3_ADLER32_NOVER) | ||
147 | -- | disable ordinary data * compression feature, only search * the source, not the target. */ | ||
148 | pattern XD3_NOCOMPRESS = Flags (#const XD3_NOCOMPRESS) | ||
149 | -- | disable the "1.5-pass * algorithm", instead use greedy * matching. Greedy is off by * default. */ | ||
150 | pattern XD3_BEGREEDY = Flags (#const XD3_BEGREEDY) | ||
151 | -- | used by "recode". */ | ||
152 | pattern XD3_ADLER32_RECODE = Flags (#const XD3_ADLER32_RECODE) | ||
153 | -- 4 bits to set the compression level the same as the command-line | ||
154 | -- setting -1 through -9 Flags (-0 corresponds to the XD3_NOCOMPRESS flag | ||
155 | -- and is independent of compression level). This is for | ||
156 | -- convenience especially with xd3_encode_memoryFlags (). */ | ||
157 | pattern XD3_COMPLEVEL_SHIFT = #const XD3_COMPLEVEL_SHIFT | ||
158 | pattern XD3_COMPLEVEL_MASK = Flags (#const XD3_COMPLEVEL_MASK) | ||
159 | pattern XD3_COMPLEVEL_1 = Flags (#const XD3_COMPLEVEL_1) | ||
160 | pattern XD3_COMPLEVEL_2 = Flags (#const XD3_COMPLEVEL_2) | ||
161 | pattern XD3_COMPLEVEL_3 = Flags (#const XD3_COMPLEVEL_3) | ||
162 | pattern XD3_COMPLEVEL_6 = Flags (#const XD3_COMPLEVEL_6) | ||
163 | pattern XD3_COMPLEVEL_9 = Flags (#const XD3_COMPLEVEL_9) | ||
164 | |||
165 | instance Monoid Flags where | ||
166 | mempty = Flags 0 | ||
167 | Flags a `mappend` Flags b = Flags (a .|. b) | ||
168 | |||
169 | -- | Settings for the secondary compressor. | ||
170 | data CompressorConfig = CompressorConfig | ||
171 | { ngroups :: Usize_t -- ^ Number of DJW Huffman groups. | ||
172 | , sector_size :: Usize_t -- ^ Sector size. | ||
173 | , inefficient :: #{type int} -- ^ If true, ignore efficiency check [avoid XD3_NOSECOND]. | ||
174 | } | ||
175 | |||
176 | -- | The values of this enumeration are set in xd3_config using the | ||
177 | -- 'smatch_cfg' variable. It can be set to default, slow, fast, etc., | ||
178 | -- and soft. | ||
179 | data SMatchSelect | ||
180 | = SMATCH_DEFAULT -- ^ Flags may contain XD3_COMPLEVEL bits, else default. | ||
181 | | SMATCH_SLOW | ||
182 | | SMATCH_FAST | ||
183 | | SMATCH_FASTER | ||
184 | | SMATCH_FASTEST | ||
185 | deriving Enum | ||
186 | |||
187 | -- | This type exists only to be a tag for Ptr to an underlying C-struct called | ||
188 | -- xd3_stream. | ||
189 | data Xd3Stream | ||
190 | |||
191 | -- | This is the record of a pre-compiled configuration, a subset of | ||
192 | -- xd3_config. (struct _xd3_smatcher) | ||
193 | data StringMatcher = StringMatcher | ||
194 | { smName :: String | ||
195 | , smStringMatch :: FunPtr (Ptr Xd3Stream -> ErrorCode) | ||
196 | , smLargeLook :: Usize_t | ||
197 | , smLargeStep :: Usize_t | ||
198 | , smSmallLook :: Usize_t | ||
199 | , smSmallChain :: Usize_t | ||
200 | , smSmallLchain :: Usize_t | ||
201 | , smMaxLazy :: Usize_t | ||
202 | , smLongEnough :: Usize_t | ||
203 | } | ||