libasterix 0.17.0 → 0.17.1

raw patch · 6 files changed

+187/−64 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• README.md +25/−45
• libasterix.cabal +1/−1
• src/Asterix/Base.hs +40/−0
• src/Asterix/Coding.hs +23/−17
• test/Common.hs +76/−0
• test/TestAsterix.hs +22/−1

@@ -219,7 +219,6 @@ ```haskell -- | file: readme-samples/subitems-get.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Data.Maybe import Asterix.Coding@@ -289,7 +288,7 @@      -- the result shall be the same     assert (unparse @Bits i120a == unparse i120b)-    assert (isEmpty i120b == False)+    assert (not $ isEmpty i120b)      -- same scenario is possible on 'Record' too     let recordA :: Record (RecordOf Cat048)@@ -341,7 +340,7 @@         -- so the function call shall have no effect         result2 = modifyExtendedSubitemIfPresent @"TST" (const 1) i020 -    assert $ not (unparse @Bits i020 == unparse result1)+    assert (unparse @Bits i020 /= unparse result1)     assert (unparse @Bits i020 == unparse result2) ``` @@ -354,7 +353,6 @@ ```haskell -- | file: readme-samples/catflt.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Control.Monad import Data.Maybe@@ -375,7 +373,7 @@ main :: IO () main = do     inputData <- receiveFromUdp-    let rawDatablocks = case (parseRawDatablocks inputData) of+    let rawDatablocks = case parseRawDatablocks inputData of             Left _ -> error "unable to parse"             Right val -> val         validDatablocks = do@@ -393,7 +391,6 @@ ```haskell -- | file: readme-samples/rewrite-sacsic.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MonoLocalBinds #-}  import GHC.TypeLits@@ -422,7 +419,7 @@         records :: [Record (RecordOf cat)]         records = case parse @StrictParsing act bs of             Left e -> error (show e)-            Right lst -> (setItem @"010" sacSic) . Record <$> lst+            Right lst -> setItem @"010" sacSic . Record <$> lst         urecords = fmap unRecord records     in datablockBuilder (natVal (Proxy @(CategoryOf cat))) urecords @@ -464,9 +461,10 @@     let newSacSic :: NonSpare TSacSic         newSacSic = group (1 *: 2 *: nil)         sOutput = rewriteSacSic newSacSic sInput-        expected = fromJust $ unhexlify $ "300011900102000000009001020000000030000a90010200000000"+        expected = fromJust $ unhexlify+            "300011900102000000009001020000000030000a90010200000000"     txBytesToTheNetwork sOutput-    case expected == (toByteString sOutput) of+    case expected == toByteString sOutput of         True -> print "OK"         False -> error "unexpected output" ```@@ -489,7 +487,6 @@ ```haskell -- | file: readme-samples/spares.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MonoLocalBinds #-}  import Data.Maybe@@ -544,7 +541,6 @@ ```haskell -- | file: readme-samples/ref.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Data.Either import Data.Maybe@@ -582,7 +578,8 @@ main = do     let s = unparse @SBuilder db         bs = toByteString s-        expected = fromJust $ unhexlify $ "3e001b8101010104010211c8010000000000020000010000028000"+        expected = fromJust $ unhexlify+            "3e001b8101010104010211c8010000000000020000010000028000"     assert (bs == expected)      -- first stage, parse to the record@@ -760,7 +757,8 @@  main :: IO () main = do-    let expected = fromJust $ unhexlify $ "3e0038bfe9bd5000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"+    let expected = fromJust $ unhexlify+            "3e0038bfe9bd5000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"         result = toByteString $ unparse @SBuilder db     putStrLn $ hexlify result     assert (result == expected)@@ -786,28 +784,14 @@ ```haskell -- | file: readme-samples/generic-latest.hs import Control.Monad-import Data.List (sort)-import Data.Map as Map-import Data.Map.Merge.Lazy as Map-import Asterix.Schema-import Asterix.Generated as Gen+import Data.Map -latest :: Map VInt VEdition-latest = Prelude.foldr f mempty Gen.manifest-  where-    f :: VAsterix -> Map VInt VEdition -> Map VInt VEdition-    f sch acc = case sch of-        GAsterixBasic cat ed _uap -> Map.merge-            preserveMissing-            preserveMissing-            (zipWithMatched (\_key ed1 ed2 -> max ed1 ed2))-            acc-            (Map.singleton cat ed)-        GAsterixExpansion _cat _ed _exp -> acc+import Asterix.Base (latestEditionsBasic)+import Asterix.Generated (manifest)  main :: IO ()-main = forM_ (sort (Map.keys latest)) $ \cat -> do-    print (cat, latest Map.! cat)+main = forM_ (assocs $ latestEditionsBasic manifest) $ \(cat, (ed, _uap)) -> do+    print (cat, ed) ```  Alternatively, a prefered way is to be explicit about each edition,@@ -925,7 +909,8 @@ main = do     let sb :: SBuilder = unparse db062         result = toByteString sb-        expected = fromJust $ unhexlify $ "3e0015911101100102003db34024304f820820029c"+        expected = fromJust $ unhexlify+            "3e0015911101100102003db34024304f820820029c"     assert (result == expected)     putStrLn $ hexlify result ```@@ -948,7 +933,6 @@ ```haskell -- | file: readme-samples/parsing-normal.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Data.ByteString (ByteString) import Asterix.Coding@@ -1048,7 +1032,6 @@ ```haskell -- | file: readme-samples/dep-content.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Control.Monad import Data.Maybe@@ -1120,7 +1103,7 @@  main :: IO () main = do-    assert ((toByteString $ unparse @SBuilder db0) == expected)+    assert (toByteString (unparse @SBuilder db0) == expected)      -- parse and interpret data from the example above     let rx = expected@@ -1129,8 +1112,8 @@         assert (rawDatablockCategory db == 62)         let act = parseRecords (schema @(RecordOf Spec) Proxy)             records :: [Record (RecordOf Spec)]-            records = fromRight (error "unexpected")-                (fmap Record <$> parse @StrictParsing act (getRawRecords db))+            records = either (const (error "unexpected")) (fmap Record)+                (parse @StrictParsing act (getRawRecords db))         forM_ (zip [0::Int ..] records) $ \(cnt, rec) -> do             let i380 = fromJust $ getItem @"380" rec                 iIAS1 = fromJust $ getItem @"IAS" $ getVariation i380@@ -1158,7 +1141,6 @@ ```haskell -- | file: readme-samples/dep-variation.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-}  import Control.Monad import Data.Maybe@@ -1231,7 +1213,7 @@  main :: IO () main = do-    assert ((toByteString $ unparse @SBuilder db0) == expected)+    assert (toByteString (unparse @SBuilder db0) == expected)      -- parse and interpret data from the example above     let rx = expected@@ -1240,8 +1222,8 @@         assert (rawDatablockCategory db == 4)         let act = parseRecords (schema @(RecordOf Spec) Proxy)             records :: [Record (RecordOf Spec)]-            records = fromRight (error "unexpected")-                (fmap Record <$> parse @StrictParsing act (getRawRecords db))+            records = either (const (error "unexpected")) (fmap Record)+                (parse @StrictParsing act (getRawRecords db))         forM_ (zip [0::Int ..] records) $ \(cnt, rec) -> do             print ("--- record", cnt, "---")             let i000 = fromJust $ getItem @"000" rec@@ -1304,7 +1286,6 @@ ```haskell -- | file: readme-samples/parsing-cat001-try.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  import Control.Monad@@ -1375,7 +1356,6 @@ ```haskell -- | file: readme-samples/parsing-cat001-tracks.hs {-# LANGUAGE DataKinds #-}-{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}  import Data.ByteString (ByteString)@@ -1468,7 +1448,7 @@         putStrLn $ debugBits $ unparse @Bits i      -- but item '000' is not present in RFS-    assert (length (getRfsItem @"000" rec1) == 0)+    assert (null $ getRfsItem @"000" rec1) ```  ### Strict and partial record parsing modes

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               libasterix-version:            0.17.0+version:            0.17.1 synopsis:           Asterix data processing library description:     This library provides features to process asterix data format, including

@@ -96,6 +96,10 @@ , HListAppend(..) , FoldHList(..) +-- * Schema and manifest+, latestEditions+, latestEditionsBasic+, latestEditionsExpansion ) where  import           Control.Applicative@@ -113,6 +117,7 @@ import qualified Data.List                 as L import           Data.Map                  (Map) import qualified Data.Map                  as Map+import qualified Data.Map.Merge.Lazy       as Map import           Data.Maybe import           Data.Proxy import           Data.String               as S@@ -888,4 +893,39 @@ -- | Unparse RawDatablock. unparseRawDatablock :: RawDatablock -> Builder unparseRawDatablock = BSB.byteString . unRawDatablock++-- | Helper function to select newer edition, augmented with some schema.+maxOn :: Ord b => (a -> b) -> a -> a -> a+maxOn f x1 x2+    | f x1 > f x2 = x1+    | otherwise = x2++-- | Extract latest editions from given manifest.+latestEditions+    :: forall a. (VAsterix -> Maybe (VInt, VEdition, a)) -- selector function+    -> [VAsterix]                                        -- manifest+    -> Map VInt (VEdition, a)+latestEditions f = foldr g mempty+  where+    g :: VAsterix -> Map Int (VEdition, a) -> Map Int (VEdition, a)+    g sch acc = case f sch of+        Nothing -> acc+        Just (cat, ed, val) -> Map.merge+            Map.preserveMissing+            Map.preserveMissing+            (Map.zipWithMatched (const (maxOn fst)))+            acc+            (Map.singleton cat (ed, val))++-- | Extract latest editions of basic cats from given manifest.+latestEditionsBasic :: [VAsterix] -> Map VInt (VEdition, VUap)+latestEditionsBasic = latestEditions $ \case+    GAsterixBasic cat ed sch -> Just (cat, ed, sch)+    GAsterixExpansion {} -> Nothing++-- | Extract latest editions of expansions from given manifest.+latestEditionsExpansion :: [VAsterix] -> Map VInt (VEdition, VExpansion)+latestEditionsExpansion = latestEditions $ \case+    GAsterixBasic {} -> Nothing+    GAsterixExpansion cat ed sch -> Just (cat, ed, sch) 

@@ -884,6 +884,13 @@     type RepetitiveInputList t2 :: Type -> Type     repetitive :: RepetitiveInputList t2 t1 -> t2 +rebuildRepetitiveRegular :: Int -> [UVariation] -> SBuilder+rebuildRepetitiveRegular nBytes lst =+    let n = integerToBits 0 (nBytes*8)+            (fromIntegral $ Prelude.length lst)+        items = fmap unparse lst+    in bitsToSBuilder $ concatBits (n NE.:| items)+ instance     ( KnownNat n     ) => MkRepetitive@@ -898,34 +905,33 @@         lst2 = fmap unVariation lst1          bld :: SBuilder-        bld =-            let nBytes = fromIntegral $ natVal (Proxy @n)-                n = integerToBits 0 (nBytes*8)-                    (fromIntegral $ Prelude.length lst2)-                items = fmap unparse lst1-            in bitsToSBuilder $ concatBits (n NE.:| items)+        bld = rebuildRepetitiveRegular (fromIntegral $ natVal (Proxy @n)) lst2 +rebuildRepetitiveFx :: NE.NonEmpty UVariation -> SBuilder+rebuildRepetitiveFx+    = bitsToSBuilder+    . concatBits+    . NE.reverse+    . NE.zipWith addFx (False NE.:| repeat True)+    . NE.reverse+    . fmap unparse+  where+    addFx :: Bool -> Bits -> Bits+    addFx flag arg = appendBits arg (boolsToBits 7 [flag])+ instance MkRepetitive         (Variation ('GRepetitive 'GRepetitiveFx var))         (Variation var)       where     type RepetitiveInputList         (Variation ('GRepetitive 'GRepetitiveFx var)) = NE.NonEmpty-    repetitive lst1 = Variation $ URepetitive (bld lst1) lst2+    repetitive lst1 = Variation $ URepetitive bld lst2       where         lst2 :: [UVariation]         lst2 = fmap unVariation (NE.toList lst1) -        addFx :: Bool -> Bits -> Bits-        addFx flag arg = appendBits arg (boolsToBits 7 [flag])--        bld :: NE.NonEmpty (Variation var) -> SBuilder-        bld = bitsToSBuilder-            . concatBits-            . NE.reverse-            . NE.zipWith addFx (False NE.:| repeat True)-            . NE.reverse-            . fmap unparse+        bld :: SBuilder+        bld = rebuildRepetitiveFx (fmap unVariation lst1)  instance     ( MkRepetitive (Variation var) ts1

@@ -2,7 +2,9 @@  module Common where +import           Data.Bool import           Data.Char+import qualified Data.List.NonEmpty as NE import           Data.Maybe import           Test.Tasty.HUnit @@ -46,4 +48,78 @@     = reverse     . dropWhile isSpace     . reverse++-- | Create record with all items set to zero/one.+populateRecord :: Bool -> VRecord -> URecord+populateRecord val (GRecord schItems) = URecord bld items+  where+    bld :: SBuilder+    bld = rebuildRecord items++    items :: [Maybe (RecordItem UNonSpare)]+    items = fmap goUapItem schItems++    goUapItem :: VUapItem -> Maybe (RecordItem UNonSpare)+    goUapItem = \case+        GUapItem nsp -> Just . RecordItem $ goNsp nsp+        _ -> Nothing++    goNsp :: VNonSpare -> UNonSpare+    goNsp (GNonSpare _name _title rv) = UNonSpare $ goRuleVar rv++    goRuleVar :: VRule VVariation -> URuleVar+    goRuleVar sch = URuleVar $ goVar $ case sch of+        GContextFree var   -> var+        GDependent _ var _ -> var++    goVar :: VVariation -> UVariation+    goVar = \case+        GElement o n _rc -> UElement $ integerToBits o n (bool 0 (-1) val)+        GGroup _o lst -> UGroup $ fmap goItem lst+        GExtended lst ->+            let extItems = [fmap goItem i | i <- lst]+                extBld = bitsToSBuilder $ recreateExtended extItems+            in UExtended extBld extItems+        GRepetitive rt var ->+            let repVar = goVar var+                repLst1 = replicate 9 (goVar var)+            in case rt of+                GRepetitiveRegular n ->+                    let repLst2 = repVar : repLst1+                        repBld = rebuildRepetitiveRegular n repLst2+                    in URepetitive repBld repLst2+                GRepetitiveFx ->+                    let repLst2 = repVar NE.:| repLst1+                        repBld = rebuildRepetitiveFx repLst2+                    in URepetitive repBld (NE.toList repLst2)+        GExplicit _met ->+            let expBits = byteStringToBits mempty+                expN = bitsToSBuilder $ integerToBits 0 8 1+                expBld = expN <> bitsToSBuilder expBits+            in UExplicit expBld expBits+        GCompound lst ->+            let compItems = [fmap goNsp i | i <- lst]+                compBld = rebuildCompound compItems+            in UCompound compBld compItems++    goItem :: VItem -> UItem+    goItem = \case+        GSpare o n -> USpare $ integerToBits o n 0+        GItem nsp -> UItem $ goNsp nsp++-- | Generate sample records from the given spec.+-- A result is a list (in case of multiple UAPs) of element, where each element+-- is a tuple (Optional[uap name], record with zeros, record with ones in each item).+sampleRecords :: VAsterix -> [(VInt, ((Maybe VText, VRecord), (URecord, URecord)))]+sampleRecords = \case+    GAsterixBasic cat _ed uap -> case uap of+        GUap sch        -> go cat (Nothing, sch)+        GUaps lst _mSel -> lst >>= \(name, sch) -> go cat (Just name, sch)+    GAsterixExpansion {} -> []+  where+    r1 = populateRecord False+    r2 = populateRecord True+    go :: Int -> (Maybe VText, VRecord)+        -> [(Int, ((Maybe VText, VRecord), (URecord, URecord)))]+    go cat (mName, sch) = [(cat, ((mName, sch), (r1 sch, r2 sch)))] 

@@ -5,7 +5,10 @@ {-# LANGUAGE DataKinds  #-} {-# LANGUAGE LambdaCase #-} -module TestAsterix (tests) where+module TestAsterix+( tests+, testRoundtrip+) where  import           Control.Monad import qualified Data.ByteString    as BS@@ -77,6 +80,7 @@     , testCase "testParse6" testParse6     , testCase "testParseNonblocking" testParseNonblocking     , testCase "testEmpty" testEmpty+    , testCase "testRoundtrip" (testRoundtrip 5)     ]  testCreate :: Assertion@@ -1257,4 +1261,21 @@         rec2 = record nil     assertEqual "rec empty1" (isEmpty rec1) False     assertEqual "rec empty2" (isEmpty rec2) True++-- | For each specification and edition, create a few records,+-- encode, decode, expect the same result+testRoundtrip :: Int -> Assertion+testRoundtrip numRecords = forM_ manifest $ \ast -> do+    forM_ (sampleRecords ast) $ \(_cat, ((_, sch), (r1, r2))) -> do+        go sch r1+        go sch r2+  where+    go :: VRecord -> URecord -> Assertion+    go sch r = do+        let records1 = replicate numRecords r+            s1 = mconcat $ fmap (toByteString . unparse @SBuilder) records1+            result = parse @StrictParsing (parseRecords sch) s1+        records2 <- either (assertFailure . show) pure result+        let s2 = mconcat $ fmap (toByteString . unparse @SBuilder) records2+        assertEqual "compare" s2 s1