module Net.Mac.Text
( encode
, encodeWith
, decode
, decodeWith
, decodeEither
, decodeEitherWith
, builder
, parser
, parserWith
) where
import Net.Types (Mac(..),MacCodec(..),MacGrouping(..))
import Net.Mac (fromOctets)
import Data.Text (Text)
import Data.Word (Word8)
import Data.Word.Synthetic (Word12)
import Data.Char (chr)
import Data.Attoparsec.Text (Parser)
import Net.Internal (rightToMaybe,c2w)
import Data.Bits (unsafeShiftL,unsafeShiftR)
import Data.Monoid
import qualified Net.Internal as Internal
import qualified Data.Attoparsec.Text as AT
import qualified Data.Text.Lazy.Builder as TBuilder
import qualified Data.Text.Builder.Fixed as FB
encode :: Mac -> Text
encode = encodeWith defCodec
encodeWith :: MacCodec -> Mac -> Text
encodeWith (MacCodec g u) m = case g of
MacGroupingNoSeparator -> case u of
True -> FB.run (fixedBuilderNoSeparator FB.word8HexFixedUpper) m
False -> FB.run (fixedBuilderNoSeparator FB.word8HexFixedLower) m
MacGroupingPairs c -> case u of
True -> FB.run (fixedBuilderPairs FB.word8HexFixedUpper) (Pair c m)
False -> FB.run (fixedBuilderPairs FB.word8HexFixedLower) (Pair c m)
MacGroupingTriples c -> case u of
True -> FB.run (fixedBuilderTriples FB.word12HexFixedUpper) (Pair c m)
False -> FB.run (fixedBuilderTriples FB.word12HexFixedLower) (Pair c m)
MacGroupingQuadruples c -> case u of
True -> FB.run (fixedBuilderQuadruples FB.word8HexFixedUpper) (Pair c m)
False -> FB.run (fixedBuilderQuadruples FB.word8HexFixedLower) (Pair c m)
withCasedBuilder :: Bool -> (FB.Builder Word8 -> a) -> a
withCasedBuilder x f = case x of
True -> f FB.word8HexFixedUpper
False -> f FB.word8HexFixedLower
decodeEitherWith :: MacCodec -> Text -> Either String Mac
decodeEitherWith codec t = AT.parseOnly (parserWith codec <* AT.endOfInput) t
decodeEither :: Text -> Either String Mac
decodeEither = decodeEitherWith defCodec
decode :: Text -> Maybe Mac
decode = decodeWith defCodec
decodeWith :: MacCodec -> Text -> Maybe Mac
decodeWith codec t = rightToMaybe (AT.parseOnly (parserWith codec <* AT.endOfInput) t)
builder :: Mac -> TBuilder.Builder
builder = TBuilder.fromText . encode
parser :: AT.Parser Mac
parser = parserWith defCodec
parserWith :: MacCodec -> AT.Parser Mac
parserWith (MacCodec g _) = case g of
MacGroupingQuadruples c -> parserQuadruples c
MacGroupingTriples c -> parserTriples c
MacGroupingPairs c -> parserPairs c
MacGroupingNoSeparator -> parserNoSeparator
defCodec :: MacCodec
defCodec = MacCodec (MacGroupingPairs ':') False
w8ToChar :: Word8 -> Char
w8ToChar = chr . fromIntegral
parserQuadruples :: Char -> Parser Mac
parserQuadruples s = fromOctets
<$> parseTwoHex <*> parseTwoHex <* AT.char s
<*> parseTwoHex <*> parseTwoHex <* AT.char s
<*> parseTwoHex <*> parseTwoHex
parserPairs :: Char -> Parser Mac
parserPairs s = fromOctets
<$> parseTwoHex <* AT.char s
<*> parseTwoHex <* AT.char s
<*> parseTwoHex <* AT.char s
<*> parseTwoHex <* AT.char s
<*> parseTwoHex <* AT.char s
<*> parseTwoHex
parserTriples :: Char -> Parser Mac
parserTriples s = do
a1 <- parseOneHex
a2 <- parseOneHex
a3 <- parseOneHex
_ <- AT.char s
a4 <- parseOneHex
a5 <- parseOneHex
a6 <- parseOneHex
_ <- AT.char s
a7 <- parseOneHex
a8 <- parseOneHex
a9 <- parseOneHex
_ <- AT.char s
a10 <- parseOneHex
a11 <- parseOneHex
a12 <- parseOneHex
return $ fromOctets
(unsafeShiftL a1 4 + a2)
(unsafeShiftL a3 4 + a4)
(unsafeShiftL a5 4 + a6)
(unsafeShiftL a7 4 + a8)
(unsafeShiftL a9 4 + a10)
(unsafeShiftL a11 4 + a12)
parserNoSeparator :: Parser Mac
parserNoSeparator = fromOctets
<$> parseTwoHex
<*> parseTwoHex
<*> parseTwoHex
<*> parseTwoHex
<*> parseTwoHex
<*> parseTwoHex
parseTwoHex :: Parser Word8
parseTwoHex = do
a <- AT.anyChar >>= parseCharHex
b <- AT.anyChar >>= parseCharHex
return (unsafeShiftL a 4 + b)
tryParseCharHex :: Parser Word8 -> Char -> Parser Word8
tryParseCharHex a c
| w >= 48 && w <= 57 = return (w 48)
| w >= 65 && w <= 70 = return (w 55)
| w >= 97 && w <= 102 = return (w 87)
| otherwise = a
where w = c2w c
parseOneHex :: Parser Word8
parseOneHex = AT.anyChar >>= parseCharHex
parseCharHex :: Char -> Parser Word8
parseCharHex = tryParseCharHex (fail "invalid hexadecimal character")
withCasedBuilderTriple :: Bool -> (FB.Builder Word12 -> a) -> a
withCasedBuilderTriple x f = case x of
True -> f FB.word12HexFixedUpper
False -> f FB.word12HexFixedLower
data Pair = Pair
{ pairSep :: !Char
, pairMac :: !Mac
}
fixedBuilderTriples :: FB.Builder Word12 -> FB.Builder Pair
fixedBuilderTriples tripBuilder =
FB.contramapBuilder (word12At 36 . pairMac) tripBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word12At 24 . pairMac) tripBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word12At 12 . pairMac) tripBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word12At 0 . pairMac) tripBuilder
fixedBuilderNoSeparator :: FB.Builder Word8 -> FB.Builder Mac
fixedBuilderNoSeparator hexBuilder =
FB.contramapBuilder (word8At 40) hexBuilder
<> FB.contramapBuilder (word8At 32) hexBuilder
<> FB.contramapBuilder (word8At 24) hexBuilder
<> FB.contramapBuilder (word8At 16) hexBuilder
<> FB.contramapBuilder (word8At 8) hexBuilder
<> FB.contramapBuilder (word8At 0) hexBuilder
fixedBuilderQuadruples :: FB.Builder Word8 -> FB.Builder Pair
fixedBuilderQuadruples pairBuilder =
FB.contramapBuilder (word8At 40 . pairMac) pairBuilder
<> FB.contramapBuilder (word8At 32 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 24 . pairMac) pairBuilder
<> FB.contramapBuilder (word8At 16 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 8 . pairMac) pairBuilder
<> FB.contramapBuilder (word8At 0 . pairMac) pairBuilder
fixedBuilderPairs :: FB.Builder Word8 -> FB.Builder Pair
fixedBuilderPairs pairBuilder =
FB.contramapBuilder (word8At 40 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 32 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 24 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 16 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 8 . pairMac) pairBuilder
<> FB.contramapBuilder pairSep FB.charBmp
<> FB.contramapBuilder (word8At 0 . pairMac) pairBuilder
word8At :: Int -> Mac -> Word8
word8At i (Mac w) = fromIntegral (unsafeShiftR w i)
word12At :: Int -> Mac -> Word12
word12At i (Mac w) = fromIntegral (unsafeShiftR w i)