Skip to content

Commit b7857a7

Browse files
chpatrickchpatrick
committed
Add $>> operator for build.
1 parent d8bafb2 commit b7857a7

7 files changed

Lines changed: 92 additions & 79 deletions

File tree

‎Data/Codec.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -39,11 +39,12 @@ import Data.Codec.Tuple
3939
--
4040
-- @
4141
-- userCodec :: JSONCodec User
42-
-- userCodec = obj "user object' $ build User
43-
-- $ f_username >-< "user"
44-
-- >>> f_userEmail >-< "email"
45-
-- >>> f_userLanguages >-< "languages"
46-
-- >>> f_userReferrer >-< opt "referrer"
42+
-- userCodec = obj "user object' $
43+
-- User
44+
-- $>> f_username >-< "user"
45+
-- >>> f_userEmail >-< "email"
46+
-- >>> f_userLanguages >-< "languages"
47+
-- >>> f_userReferrer >-< opt "referrer"
4748
-- @
4849
--
49-
-- The type system ensures that every field is provided exactly once.
50+
-- The type system ensures that every field is provided exactly once.

‎Data/Codec/Field.hs‎

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module Data.Codec.Field
44
Field(..)
55
, Build(..)
66
, Con(..)
7-
, (>>>), done
7+
, ($>>), (>>>), done
88
, X(X), Buildable(..)
99
, having, build
1010
) where
@@ -58,5 +58,10 @@ build :: (Functor f, Buildable r y) => x -> Build r f x y -> f r
5858
build x (Build b)
5959
= (\f -> give $ f x) <$> b
6060

61+
-- | Infix version of `build`.
62+
($>>) :: (Functor f, Buildable r y) => x -> Build r f x y -> f r
63+
($>>) = build
64+
infixr 1 $>>
65+
6166
-- | A constructor for a given record and a way to check whether it has it.
62-
data Con r x = Con x (r -> Bool)
67+
data Con r x = Con x (r -> Bool)

‎Examples/Foreign.hsc‎

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -30,16 +30,17 @@ genFields ''TM
3030
hsc_printf(")");
3131

3232
cTimeCodec :: ForeignCodec TM
33-
cTimeCodec = build TM
34-
$ f_seconds >-< (#numField struct tm, tm_sec) cast
35-
>>> f_minutes >-< (#numField struct tm, tm_min) cast
36-
>>> f_hours >-< (#numField struct tm, tm_hour) cast
37-
>>> f_monthDay >-< (#numField struct tm, tm_mday) cast
38-
>>> f_month >-< (#numField struct tm, tm_mon) cast
39-
>>> f_year >-< (#numField struct tm, tm_year) cast
40-
>>> f_weekDay >-< (#numField struct tm, tm_wday) cast
41-
>>> f_yearDay >-< (#numField struct tm, tm_yday) cast
42-
>>> f_daylightSavingTime >-< (#numField struct tm, tm_yday) cBool
33+
cTimeCodec =
34+
TM
35+
$>> f_seconds >-< (#numField struct tm, tm_sec) cast
36+
>>> f_minutes >-< (#numField struct tm, tm_min) cast
37+
>>> f_hours >-< (#numField struct tm, tm_hour) cast
38+
>>> f_monthDay >-< (#numField struct tm, tm_mday) cast
39+
>>> f_month >-< (#numField struct tm, tm_mon) cast
40+
>>> f_year >-< (#numField struct tm, tm_year) cast
41+
>>> f_weekDay >-< (#numField struct tm, tm_wday) cast
42+
>>> f_yearDay >-< (#numField struct tm, tm_yday) cast
43+
>>> f_daylightSavingTime >-< (#numField struct tm, tm_yday) cBool
4344

4445
instance Storable TM where
4546
sizeOf _ = #{size struct tm}
@@ -71,4 +72,4 @@ testTime = TM
7172
, weekDay = 0
7273
, yearDay = 0
7374
, daylightSavingTime = False
74-
}
75+
}

‎Examples/IP.hs‎

Lines changed: 15 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -23,17 +23,18 @@ data IPv4 = IPv4
2323
genFields ''IPv4
2424

2525
ipv4Codec :: BitCodec IPv4
26-
ipv4Codec = build IPv4
27-
$ f_version >-< word8 4
28-
>>> f_ihl >-< word8 4
29-
>>> f_dscp >-< word8 6
30-
>>> f_ecn >-< word8 2
31-
>>> f_totalLength >-< word16be 16
32-
>>> f_identification >-< word16be 16
33-
>>> f_flags >-< word8 3
34-
>>> f_fragmentOffset >-< word16be 13
35-
>>> f_timeToLive >-< word8 8
36-
>>> f_protocol >-< word8 8
37-
>>> f_headerChecksum >-< word16be 16
38-
>>> f_sourceIP >-< word32be 32
39-
>>> f_destIP >-< word32be 32
26+
ipv4Codec =
27+
IPv4
28+
$>> f_version >-< word8 4
29+
>>> f_ihl >-< word8 4
30+
>>> f_dscp >-< word8 6
31+
>>> f_ecn >-< word8 2
32+
>>> f_totalLength >-< word16be 16
33+
>>> f_identification >-< word16be 16
34+
>>> f_flags >-< word8 3
35+
>>> f_fragmentOffset >-< word16be 13
36+
>>> f_timeToLive >-< word8 8
37+
>>> f_protocol >-< word8 8
38+
>>> f_headerChecksum >-< word16be 16
39+
>>> f_sourceIP >-< word32be 32
40+
>>> f_destIP >-< word32be 32

‎Examples/JSON.hs‎

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -17,14 +17,15 @@ data User = User
1717
genFields ''User
1818

1919
userCodec :: JSONCodec User
20-
userCodec = obj "user object" $ build User
21-
$ f_username >-< "user" -- entry with FromJSON/ToJSON serialization
22-
>>> f_userEmail >-< "email"
23-
>>> f_userLanguages >-< "languages"
24-
>>> f_userReferrer >-< opt (entry "referrer" userCodec) -- entry with specific codec
20+
userCodec = obj "user object" $
21+
User
22+
$>> f_username >-< "user" -- entry with FromJSON/ToJSON serialization
23+
>>> f_userEmail >-< "email"
24+
>>> f_userLanguages >-< "languages"
25+
>>> f_userReferrer >-< opt (entry "referrer" userCodec) -- entry with specific codec
2526

2627
instance FromJSON User where
2728
parseJSON = parseVal userCodec
2829

2930
instance ToJSON User where
30-
toJSON = produceVal userCodec
31+
toJSON = produceVal userCodec

‎Examples/Tar.hs‎

Lines changed: 19 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -34,23 +34,24 @@ genFields ''Header
3434

3535
-- easy peasy
3636
headerCodec :: BinaryCodec Header
37-
headerCodec = build Header
38-
$ f_headerName >-< bytes' 100 -- Codec will de/serialize in this order
39-
>>> f_headerMode >-< octal 8
40-
>>> f_headerOwnerUID >-< octal 8
41-
>>> f_headerOwnerGID >-< octal 8
42-
>>> f_headerFileSize >-< octal 12
43-
>>> f_headerModifyTime >-< octal 12
44-
>>> f_headerChecksum >-< octal 8
45-
>>> f_headerType >-< word8
46-
>>> f_headerLinkName >-< bytes' 100
47-
>>> f_headerMagic >-< bytes' 6
48-
>>> f_headerVersion >-< octal 2
49-
>>> f_headerOwnerUserName >-< bytes' 32
50-
>>> f_headerOwnerGroupName >-< bytes' 32
51-
>>> f_headerDeviceMajorNumber >-< octal 8
52-
>>> f_headerDeviceMinorNumber >-< octal 8
53-
>>> f_headerFilenamePrefix >-< bytes' 155
37+
headerCodec =
38+
Header
39+
$>> f_headerName >-< bytes' 100 -- Codec will de/serialize in this order
40+
>>> f_headerMode >-< octal 8
41+
>>> f_headerOwnerUID >-< octal 8
42+
>>> f_headerOwnerGID >-< octal 8
43+
>>> f_headerFileSize >-< octal 12
44+
>>> f_headerModifyTime >-< octal 12
45+
>>> f_headerChecksum >-< octal 8
46+
>>> f_headerType >-< word8
47+
>>> f_headerLinkName >-< bytes' 100
48+
>>> f_headerMagic >-< bytes' 6
49+
>>> f_headerVersion >-< octal 2
50+
>>> f_headerOwnerUserName >-< bytes' 32
51+
>>> f_headerOwnerGroupName >-< bytes' 32
52+
>>> f_headerDeviceMajorNumber >-< octal 8
53+
>>> f_headerDeviceMinorNumber >-< octal 8
54+
>>> f_headerFilenamePrefix >-< bytes' 155
5455

5556
-- byte field with trailing nulls stripped
5657
bytes' :: Int -> BinaryCodec B.ByteString
@@ -74,4 +75,4 @@ octal n = mapCodecM parseOct makeOct (byteString n)
7475
makeOct x
7576
| B.length octBS > n - 1 = fail "Octal value too large for field."
7677
| otherwise = return $ BC.replicate (n - 1 - B.length octBS) '0' `B.append` octBS `B.snoc` 0
77-
where octBS = BC.pack $ showOct x ""
78+
where octBS = BC.pack $ showOct x ""

‎codec.cabal‎

Lines changed: 25 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -10,11 +10,12 @@ description:
1010
.
1111
@
1212
userCodec :: JSONCodec User
13-
userCodec = obj "user object" $ build User
14-
&#x20; $ f_username >-< "user"
15-
&#x20; >>> f_userEmail >-< "email"
16-
&#x20; >>> f_userLanguages >-< "languages"
17-
&#x20; >>> f_userReferrer >-< opt "referrer"
13+
userCodec = obj "user object" $
14+
&#x20; User
15+
&#x20; $>> f_username >-< "user"
16+
&#x20; >>> f_userEmail >-< "email"
17+
&#x20; >>> f_userLanguages >-< "languages"
18+
&#x20; >>> f_userReferrer >-< opt "referrer"
1819
.
1920
instance FromJSON User where
2021
&#x20; parseJSON = parseVal userCodec
@@ -27,29 +28,31 @@ description:
2728
.
2829
@
2930
ipv4Codec :: BitCodec IPv4
30-
ipv4Codec = build IPv4
31-
&#x20; $ f_version >-< word8 4
32-
&#x20; >>> f_ihl >-< word8 4
33-
&#x20; >>> f_dscp >-< word8 6
34-
&#x20; >>> f_ecn >-< word8 2
35-
&#x20; >>> f_totalLength >-< word16be 16
36-
&#x20; >>> f_identification >-< word16be 16
37-
&#x20; >>> f_flags >-< word8 3
38-
&#x20; >>> f_fragmentOffset >-< word16be 13
39-
&#x20; >>> f_timeToLive >-< word8 8
40-
&#x20; >>> f_protocol >-< word8 8
41-
&#x20; >>> f_headerChecksum >-< word16be 16
42-
&#x20; >>> f_sourceIP >-< word32be 32
43-
&#x20; >>> f_destIP >-< word32be 32
31+
ipv4Codec =
32+
&#x20; IPv4
33+
&#x20; $>> f_version >-< word8 4
34+
&#x20; >>> f_ihl >-< word8 4
35+
&#x20; >>> f_dscp >-< word8 6
36+
&#x20; >>> f_ecn >-< word8 2
37+
&#x20; >>> f_totalLength >-< word16be 16
38+
&#x20; >>> f_identification >-< word16be 16
39+
&#x20; >>> f_flags >-< word8 3
40+
&#x20; >>> f_fragmentOffset >-< word16be 13
41+
&#x20; >>> f_timeToLive >-< word8 8
42+
&#x20; >>> f_protocol >-< word8 8
43+
&#x20; >>> f_headerChecksum >-< word16be 16
44+
&#x20; >>> f_sourceIP >-< word32be 32
45+
&#x20; >>> f_destIP >-< word32be 32
4446
@
4547
.
4648
Storable!
4749
.
4850
@
4951
timeSpecCodec :: ForeignCodec TimeSpec
50-
timeSpecCodec = build TimeSpec
51-
&#x20; $ f_seconds >-< field (#offset struct timespec, tv_sec) cInt
52-
&#x20; >>> f_nanoseconds >-< field (#offset struct timespec, tv_nsec) cInt
52+
timeSpecCodec =
53+
&#x20; TimeSpec
54+
&#x20; $>> f_seconds >-< field (#offset struct timespec, tv_sec) cInt
55+
&#x20; >>> f_nanoseconds >-< field (#offset struct timespec, tv_nsec) cInt
5356
.
5457
instance Storable TimeSpec where
5558
&#x20; peek = peekWith timeSpecCodec

0 commit comments

Comments
 (0)