diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/libasterix.cabal b/libasterix.cabal --- a/libasterix.cabal +++ b/libasterix.cabal @@ -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 diff --git a/src/Asterix/Base.hs b/src/Asterix/Base.hs --- a/src/Asterix/Base.hs +++ b/src/Asterix/Base.hs @@ -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) diff --git a/src/Asterix/Coding.hs b/src/Asterix/Coding.hs --- a/src/Asterix/Coding.hs +++ b/src/Asterix/Coding.hs @@ -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 diff --git a/test/Common.hs b/test/Common.hs --- a/test/Common.hs +++ b/test/Common.hs @@ -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)))] diff --git a/test/TestAsterix.hs b/test/TestAsterix.hs --- a/test/TestAsterix.hs +++ b/test/TestAsterix.hs @@ -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