fits-parse 0.3.6 → 0.4.1

raw patch · 8 files changed

+304/−249 lines, 8 filesdep −containersdep ~JuicyPixelsdep ~binarydep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependencies removed: containers

Dependency ranges changed: JuicyPixels, binary, bytestring, fast-logger, megaparsec, microlens, microlens-th, mtl, optparse-applicative, statistics, tasty, tasty-hunit, text, text-latin1, vector

API changes (from Hackage documentation)

Files

• fits-parse.cabal +24/−27
• package.yaml +0/−76
• src/Data/Fits.hs +65/−31
• src/Data/Fits/MegaParser.hs +94/−55
• src/Data/Fits/Read.hs +8/−12
• stack.yaml +1/−1
• stack.yaml.lock +4/−4
• test/Spec.hs +108/−43

@@ -1,6 +1,6 @@ cabal-version:      1.12 name:               fits-parse-version:            0.3.6+version:            0.4.1 license:            BSD2 license-file:       LICENSE copyright:          Copyright (c) 2023 Zac Slade@@ -18,7 +18,6 @@     README.md     stack.yaml     stack.yaml.lock-    package.yaml     docs/Makefile     docs/make.bat     docs/conf.py@@ -46,14 +45,13 @@     default-language: Haskell2010     build-depends:         base >=4.7 && <5,-        binary,-        bytestring,-        containers,-        megaparsec,-        microlens,-        microlens-th,-        text,-        text-latin1+        binary >=0.8.9.1 && <0.9,+        bytestring >=0.11.5.3 && <0.12,+        megaparsec >=9.5.0 && <9.6,+        microlens >=0.4.13.1 && <0.5,+        microlens-th >=0.4.3.15 && <0.5,+        text >=2.0.2 && <2.1,+        text-latin1 >=0.3.1 && <0.4  executable omnibus     main-is:          Main.hs@@ -61,16 +59,16 @@     other-modules:    Paths_fits_parse     default-language: Haskell2010     build-depends:-        JuicyPixels,+        JuicyPixels >=3.3.9 && <3.4,         base >=4.7 && <5,-        bytestring,-        fast-logger,+        bytestring >=0.11.5.3 && <0.12,+        fast-logger >=3.2.3 && <3.3,         fits-parse,-        microlens,-        microlens-th,-        optparse-applicative,-        statistics,-        vector+        microlens >=0.4.13.1 && <0.5,+        microlens-th >=0.4.3.15 && <0.5,+        optparse-applicative >=0.18.1.0 && <0.19,+        statistics >=0.16.2.1 && <0.17,+        vector >=0.13.1.0 && <0.14      if flag(examples) @@ -82,13 +80,12 @@     default-language: Haskell2010     build-depends:         base >=4.7 && <5,-        bytestring,-        containers,+        bytestring >=0.11.5.3 && <0.12,         fits-parse,-        megaparsec,-        microlens,-        microlens-th,-        mtl,-        tasty,-        tasty-hunit,-        text+        megaparsec >=9.5.0 && <9.6,+        microlens >=0.4.13.1 && <0.5,+        microlens-th >=0.4.3.15 && <0.5,+        mtl >=2.3.1 && <2.4,+        tasty >=1.4.3 && <1.5,+        tasty-hunit >=0.10.2 && <0.11,+        text >=2.0.2 && <2.1

@@ -1,76 +0,0 @@-name:                fits-parse-version:             0.3.6-synopsis:            Parse FITS files-description:         Parse and manipulate FITS data natively in Haskell-homepage:            https://github.com/krakrjak/fits-parse#readme-license:             BSD2-author:              Zac Slade-maintainer:-  - Zac Slade <krakrjak@gmail.com>-  - Sean Hess-copyright:           Copyright (c) 2023 Zac Slade-category:            Science-extra-source-files:-  - README.md-  - stack.yaml-  - stack.yaml.lock-  - package.yaml-  - docs/Makefile-  - docs/make.bat-  - docs/conf.py-  - docs/index.rst-  - docs/examples/omnibus.rst-  - fits_files/*.fits-  - fits_files/*.txt-  - fits_files/nonconformant/*.fits--flags:-  examples:-    description: Do you want to build the examples?-    manual: true-    default: false--dependencies:-  - base >= 4.7 && < 5-  - bytestring-  - microlens-  - microlens-th--library:-  source-dirs: src-  dependencies:-      - containers-      - text-      - megaparsec-      - text-latin1-      - binary--executables:-  omnibus:-    when:-      - condition: flag(examples)-        buildable: true-    source-dirs: examples/omnibus-    main: Main.hs-    dependencies:-    - fits-parse-    - optparse-applicative-    - JuicyPixels-    - fast-logger-    - vector-    - statistics---tests:-  fits-tests:-    source-dirs: test-    main: Spec.hs-    dependencies:-    - fits-parse-    - containers-    - tasty-    - tasty-hunit-    - text-    - megaparsec-    - mtl-

@@ -31,17 +31,20 @@        -- ** Header Data Types     , Header(..)-    , keywords -- ^ lens for Keyword Map in Header+    , keywords -- ^ get only keywords+    , records -- ^ access all header records+    , HeaderRecord(..)+    , KeywordRecord(..)     , Extension(..)+    , getKeywords     , Data.Fits.lookup-    , Keyword(..)+    , isKeyword     , Value(..)     , toInt, toFloat, toText     , LogicalConstant(..)     , Dimensions(..)     , axes     , bitpix-    , Comment(..)     , SimpleFormat(..)     , BitPixFormat(..)     , Axes@@ -66,23 +69,23 @@ ---- bytestring import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL-import qualified Data.Map as Map  import Data.String (IsString)+import qualified Data.List as L+import Data.Maybe (mapMaybe)  ---- ghc import GHC.TypeNats (KnownNat, Nat)  ---- text import Data.Text ( Text )-import Data.Map ( Map ) import Data.List ( intercalate )  ---- bytestring import Data.ByteString ( ByteString )  ---- microlens-import Lens.Micro ((^.))+import Lens.Micro ((^.), SimpleGetter, to) ---- microlens-th import Lens.Micro.TH ( makeLenses ) @@ -123,17 +126,12 @@     deriving (Eq, Show)                     -- ^ Value of SIMPLE=T in the header. /supported/                     -- NonConformat-                    -- ^ Value of SIMPLE=F in the header. /unsupported/+                    -- ^ Value of SIMPLE=F in the header. /unsupported/data/fi  {-| Direct encoding of a `Bool` for parsing `Value` -} data LogicalConstant = T | F     deriving (Show, Eq) -{-| The `Text` wrapper for HDU the keyword data for lines of the form:-    KEYWORD=VALUE--}-newtype Keyword = Keyword Text-    deriving (Show, Eq, Ord, IsString)  {-| `Value` datatype for discriminating valid FITS KEYWORD=VALUE types in an HDU. -} data Value@@ -144,6 +142,28 @@     deriving (Show, Eq)  +{-| A single 80 character header keyword line of the form: KEYWORD = VALUE / comment+    KEYWORD=VALUE+-}+data KeywordRecord = KeywordRecord+  { _keyword :: Text+  , _value :: Value+  , _comment :: Maybe Text+  }+  deriving (Show, Eq)+$(makeLenses ''KeywordRecord)++{-| Headers contain lines that are any of the following++ > KEYWORD = VALUE / inline comment+ > COMMENT full line comment+ > (blank)+-}+data HeaderRecord+    = Keyword KeywordRecord+    | Comment Text+    | BlankLine+    deriving (Show, Eq) {-| 'Axes' represents the combination of NAXIS + NAXISn. The spec supports up to 999 axes -} type Axes = [Int] @@ -283,37 +303,54 @@     metadata, but also specifying how to make sense of the binary payload     that starts 2,880 bytes after the start of the 'HeaderData'. -}-newtype Header = Header { _keywords :: Map Keyword Value }-    deriving (Eq)+newtype Header = Header { _records :: [HeaderRecord] }+    deriving (Eq, Semigroup, Monoid) $(makeLenses ''Header) ++-- | Return all 'KeywordRecord's from the header, filtering out full-line comments and blanks+keywords :: SimpleGetter Header [KeywordRecord]+keywords = to getKeywords+++-- | Return all 'KeywordRecord's from the header, filtering out full-line comments and blanks+getKeywords :: Header -> [KeywordRecord]+getKeywords h = mapMaybe toKeyword $ h ^. records+  where+    toKeyword (Keyword k) = Just k+    toKeyword _ = Nothing++ instance Show Header where   show h =-    let kvs = Map.toList (h ^. keywords) :: [(Keyword, Value)]-    in T.unpack $ T.intercalate "\n" $ fmap line kvs+    T.unpack $ T.intercalate "\n" $ fmap line $ h ^. records     where-      ---      -- init :: [Text]-      -- init = map T.pack-      --   [ "BITPIX =" <> show h.size.bitpix-      --   , "NAXES  =" <> show h.size.naxes-      --   ]--      line :: (Keyword, Value) -> Text-      line (Keyword k, v) =+      line :: HeaderRecord -> Text+      line (Keyword (KeywordRecord k v mc)) =         T.justifyLeft 8 ' ' k         <> "="         <> T.justifyLeft (hduRecordLength - 10) ' ' (T.pack $ val v)+        <> inlineComment mc+      line (Comment c) = c+      line BlankLine = " " +      inlineComment Nothing = ""+      inlineComment (Just c) = " / " <> c+       val (Integer n) = show n       val (Float f) = show f       val (Logic T) = "              T"       val (String t) = T.unpack t -lookup :: Keyword -> Header -> Maybe Value-lookup k h = Map.lookup k (h ^. keywords)+lookup :: Text -> Header -> Maybe Value+lookup k h = do+  kr <- L.find (isKeyword k) (h ^. keywords)+  pure $ kr ^. value +isKeyword :: Text -> KeywordRecord -> Bool+isKeyword k kr = kr ^. keyword == k + data Extension     -- | Any header data unit can use the primary format. The first MUST be     -- Primary. This is equivalent to having no extension@@ -354,10 +391,7 @@     } deriving (Show, Eq) $(makeLenses ''Dimensions) -newtype Comment = Comment Text-    deriving (Show, Eq, Ord, IsString) - {-| The 'HeaderDataUnit' is the full HDU. Both the header information is     encoded alongside the data payload. -}@@ -373,7 +407,7 @@ instance Show HeaderDataUnit where     show hdu = intercalate "\n"        [ "HeaderDataUnit:"-      , "  headers = " <> show (Map.size (hdu ^. header . keywords))+      , "  headers = " <> show (length (hdu ^. header . keywords))       , "  extension = " <> show (hdu ^. extension)       , "  mainData = " <> show (BS.length (hdu ^. mainData)) <> " Bytes"       ]

@@ -18,10 +18,9 @@ ---- bytestring import qualified Data.ByteString as BS import qualified Data.ByteString.Internal as BS ( c2w )----- containers-import qualified Data.Map.Lazy as Map ---- megaparsec import qualified Text.Megaparsec as M+import qualified Text.Megaparsec.Char as MC import qualified Text.Megaparsec.Stream as M import qualified Text.Megaparsec.Pos as MP import qualified Text.Megaparsec.Byte as M@@ -31,15 +30,13 @@ import qualified Data.Text.Encoding as TE ---- local imports import qualified Data.Fits as Fits-import qualified Data.Text.Encoding as C8+import qualified Data.ByteString.Char8 as C8 import qualified Data.Binary as C8   -- symbol imports ---- bytestring import Data.ByteString ( ByteString )----- containers-import Data.Map ( Map ) ---- text import Data.Text ( Text ) ---- megaparsec@@ -50,7 +47,7 @@ ---- base import Control.Applicative ( (<$>) ) import Control.Exception ( Exception(displayException) )-import Control.Monad ( void, foldM )+import Control.Monad ( void, foldM, replicateM_ ) import Data.Bifunctor ( first ) import Data.Char ( ord ) import Data.Maybe ( catMaybes, fromMaybe )@@ -59,11 +56,11 @@ ---- local imports import Data.Fits   ( Axes-  , Comment(Comment)   , Dimensions(Dimensions)   , Header(Header)+  , KeywordRecord(..)+  , HeaderRecord(..)   , HeaderDataUnit(HeaderDataUnit)-  , Keyword(Keyword)   , BitPixFormat(..)   , Extension(..)   , LogicalConstant(..)@@ -92,65 +89,102 @@   -- | Consumes ALL header blocks until end, then all remaining space-parseHeader :: Parser (Map Keyword Value)+parseHeader :: Parser Header parseHeader = do     pairs <- M.manyTill parseRecordLine (M.string' "end")     M.space -- consume space padding all the way to the end of the next 2880 bytes header block-    return $ Map.fromList $ catMaybes pairs+    return $ Header pairs -parseRecordLine :: Parser (Maybe (Keyword, Value))+parseRecordLine :: Parser HeaderRecord parseRecordLine = do-    M.try $ Just <$> parseKeywordRecord-    <|> Nothing <$ parseLineComment-    <|> Nothing <$ M.string' (BS.replicate hduRecordLength (toWord ' '))+    M.try (Keyword <$> parseKeywordRecord)+      <|> M.try (Comment <$> parseLineComment)+      <|> BlankLine <$ parseLineBlank --- | Combinator to allow for parsing a record with inline comments-withComments :: Parser a -> Parser a-withComments parse = do-    start <- parsePos-    a <- parse-    M.space-    M.optional $ parseInlineComment start-    M.space-    return a -parseKeywordRecord :: Parser (Keyword, Value)-parseKeywordRecord = withComments parseKeywordValue+parseKeywordRecord :: Parser KeywordRecord+parseKeywordRecord = do+    ((k, v), mc) <- withComments parseKeywordValue+    pure $ KeywordRecord k v mc  -- | Parses the specified keyword parseKeywordRecord' :: ByteString -> Parser a -> Parser a-parseKeywordRecord' k pval = withComments $ do+parseKeywordRecord' k pval = ignoreComments $ do     M.string' k     parseEquals     pval -parseKeywordValue :: Parser (Keyword, Value)++++-- | Combinator to allow for parsing a record with inline comments+withComments :: Parser a -> Parser (a, Maybe Text)+withComments parse = do+    -- assumes we are at the beginning of the line+    lineStart <- parsePos+    a <- parse+    mc <- parseLineEnd lineStart+    return (a, mc)++ignoreComments :: Parser a -> Parser a+ignoreComments parse = do+    (a, _) <- withComments parse+    pure a+++parseKeywordValue :: Parser (Text, Value) parseKeywordValue = do     key <- parseKeyword     parseEquals     val <- parseValue     return (key, val) -parseInlineComment :: Int -> Parser Comment-parseInlineComment start = do-    M.char $ toWord '/'++parseLineEnd :: Int -> Parser (Maybe Text)+parseLineEnd lineStart = do+  M.try (Nothing <$ spacesToLineEnd lineStart) <|> (Just <$> parseInlineComment lineStart)+++spacesToLineEnd :: Int -> Parser ()+spacesToLineEnd lineStart = do+  curr <- parsePos+  let used = curr - lineStart+  parseSpacesN (hduRecordLength - used)+  pure ()++parseSpacesN :: Int -> Parser ()+parseSpacesN n = replicateM_ n (M.char $ toWord ' ')++parseInlineComment :: Int -> Parser Text+parseInlineComment lineStart = do+    -- any number of spaces... the previous combinator has eaten up blank lines already     M.space-    com <- parsePos-    let end = start + hduRecordLength-    let rem = end - com-    c <- M.count rem M.anySingle-    return $ Comment (wordsText c)+    M.char $ toWord '/'+    M.optional charSpace+    curr <- parsePos+    let used = curr - lineStart+    c <- M.count (hduRecordLength - used) M.anySingle+    return $ T.strip $ wordsText c+  where+    charSpace = M.char $ toWord ' ' -parseLineComment :: Parser Comment++parseLineComment :: Parser Text parseLineComment = do     let keyword = "COMMENT " :: ByteString     M.string' keyword     c <- M.count (hduRecordLength - BS.length keyword) M.anySingle-    return $ Comment (wordsText c)+    return $ wordsText c +parseLineBlank :: Parser ()+parseLineBlank = do+  M.string' (BS.replicate hduRecordLength (toWord ' '))+  pure ()++ -- | Anything but a space or equals-parseKeyword :: Parser Keyword-parseKeyword = Keyword . wordsText <$> M.some (M.noneOf $ fmap toWord [' ', '='])+parseKeyword :: Parser Text+parseKeyword = wordsText <$> M.some (M.noneOf $ fmap toWord [' ', '='])  parseValue :: Parser Value parseValue =@@ -168,8 +202,7 @@  parseLogic :: Parser LogicalConstant parseLogic = do-    M.string' "T"-    return T+    T <$ M.string' "T" <|> F <$ M.string' "F"  parseStringContinue :: Parser Text parseStringContinue = do@@ -195,7 +228,7 @@     return (T.stripEnd $ wordsText ls)     where quote = toWord '\'' -requireKeyword :: Keyword -> Header -> Parser Value+requireKeyword :: Text -> Header -> Parser Value requireKeyword k kvs = do     case Fits.lookup k kvs of       Nothing -> fail $ "Missing: " <> show k@@ -243,11 +276,7 @@     mapM parseN [1..n]   where     parseN :: Int -> Parser Int-    parseN n = withComments $ do-      M.string' "NAXIS"-      M.string' $ BS.pack $ map toWord (show n)-      parseEquals-      parseInt+    parseN n = parseKeywordRecord' (C8.pack $ "NAXIS" <> show n) parseInt  -- | We don't parse simple here, because it isn't required on all HDUs parseDimensions :: Parser Dimensions@@ -257,20 +286,30 @@  parsePrimary :: Parser HeaderDataUnit parsePrimary = do-    parseKeywordRecord' "SIMPLE" parseLogic-    dm <- M.lookAhead parseDimensions+    dm <- parsePrimaryKeywords     hd <- parseHeader     dt <- parseMainData dm-    return $ HeaderDataUnit (Header hd) dm Primary dt+    return $ HeaderDataUnit hd dm Primary dt ++parsePrimaryKeywords :: Parser Dimensions+parsePrimaryKeywords = do+    parseKeywordRecord' "SIMPLE" parseLogic+    M.lookAhead parseDimensions++ parseImage :: Parser HeaderDataUnit parseImage = do-    withComments $ M.string' "XTENSION= 'IMAGE   '"-    dm <- M.lookAhead parseDimensions+    dm <- parseImageKeywords     hd <- parseHeader     dt <- parseMainData dm-    return $ HeaderDataUnit (Header hd) dm Image dt+    return $ HeaderDataUnit hd dm Image dt +parseImageKeywords :: Parser Dimensions+parseImageKeywords = do+    ignoreComments $ M.string' "XTENSION= 'IMAGE   '"+    M.lookAhead parseDimensions+ parseBinTable :: Parser HeaderDataUnit parseBinTable = do     (dm, pc) <- M.lookAhead parseBinTableKeywords@@ -278,13 +317,13 @@     dt <- parseMainData dm     hp <- parseBinTableHeap     let tab = BinTable pc hp-    return $ HeaderDataUnit (Header hd) dm tab dt+    return $ HeaderDataUnit hd dm tab dt     where       parseBinTableHeap = return ""  parseBinTableKeywords :: Parser (Dimensions, Int) parseBinTableKeywords = do -  withComments $ M.string' "XTENSION= 'BINTABLE'"+  ignoreComments $ M.string' "XTENSION= 'BINTABLE'"   sz <- parseDimensions   pc <- parseKeywordRecord' "PCOUNT" parseInt   return (sz, pc)

@@ -1,4 +1,3 @@-{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} module Data.Fits.Read where @@ -8,9 +7,10 @@ import Data.Maybe ( listToMaybe ) import Data.Text ( Text, unpack ) import qualified Data.ByteString as BS-import qualified Data.Map.Lazy as Map+import qualified Data.List as L import qualified Text.Megaparsec as M import Data.List ( find )+import Lens.Micro ((^.))  ---- local imports import Data.Fits as Fits@@ -31,12 +31,8 @@ -- | Look up a keyword and parse it into the expected format getKeyword :: Text -> (Value -> Maybe a) -> HeaderDataUnit -> Either String a getKeyword k fromVal hdu = do-    let key = Keyword k-    v <- maybeError (MissingKey key) $ Map.lookup key (_keywords . _header $ hdu)-    maybeError (InvalidKey key v) $ fromVal v-  where-    findKey :: Keyword -> Header -> Maybe Value-    findKey key h = Map.lookup key (_keywords h)+    v <- maybeError (MissingKey k) $ Fits.lookup k (hdu ^. header)+    maybeError (InvalidKey k v) $ fromVal v  -- | Get the HDU at an index and fail with a readable error getHDU :: String -> Int -> [HeaderDataUnit] -> Either String HeaderDataUnit@@ -53,16 +49,16 @@  data FitsError     = ParseError ParseErr-    | MissingKey Keyword-    | InvalidKey Keyword Value+    | MissingKey Text+    | InvalidKey Text Value     | MissingHDU String Int      | InvalidData String     deriving (Eq)  instance Show FitsError where     show (ParseError e) = displayException e-    show (MissingKey (Keyword k)) = "Keyword Missing: " <> unpack k-    show (InvalidKey (Keyword k) val) = "Keyword: " <> unpack k <> " was invalid. Got " <> show val+    show (MissingKey k) = "Keyword Missing: " <> unpack k+    show (InvalidKey k val) = "Keyword: " <> unpack k <> " was invalid. Got " <> show val     show (MissingHDU name n) = "HDU Missing: " <> name <> " at index " <> show n     show (InvalidData err) = "Data Invalid: " <> err 

@@ -1,4 +1,4 @@-resolver: lts-21.16+resolver: lts-22.31 pvp-bounds: both  ### Uncomment the next three lines to build the examples

@@ -6,7 +6,7 @@ packages: [] snapshots: - completed:-    sha256: 1d663bec402f77fa09fa3e8cf288c3c7eb18a1f28a5e0c331ac47adeacd21346-    size: 640034-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/16.yaml-  original: lts-21.16+    sha256: acaab6ca693211938d1542abcb1c83a2f298b9f6b571854a9d38febe39b6408e+    size: 719577+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/31.yaml+  original: lts-22.31

@@ -5,7 +5,8 @@ module Main where -- qualified imports ---- base-import qualified Data.Map.Strict as Map+import Prelude hiding (lookup)+import qualified Data.List as L ---- bytestring import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as C8@@ -40,28 +41,34 @@ import Data.Fits ( Axes                  , BitPixFormat(..)                  , bitPixToByteSize-                 , Comment(Comment)                  , Dimensions                  , axes                  , bitpix                  , Extension(..)                  , Header+                 , KeywordRecord(..)                  , keywords+                 , records                  , HeaderDataUnit                  , header+                 , HeaderRecord(..)                  , dimensions                  , extension                  , mainData-                 , Keyword(Keyword)+                 , lookup                  , LogicalConstant(..)                  , Value(..)                  , hduBlockSize                  ) import Data.Fits.MegaParser import Data.Fits.Read+import System.IO + main :: IO ()-main =+main = do+  hSetBuffering stdout LineBuffering+  hSetBuffering stderr LineBuffering   testMain $ runTests "Tests" $ do     basicParsing     keywordValueLines@@ -103,11 +110,11 @@    it "should parse a keyword" $ do     res <- parse parseKeyword "WS_TEMP ="-    res @?= Keyword "WS_TEMP"+    res @?= "WS_TEMP"    it "should handle keyword symbols" $ do     res <- parse parseKeyword "OBSGEO-X=   -5466045.256954942 / [m]"-    res @?= Keyword "OBSGEO-X"+    res @?= "OBSGEO-X"   @@ -134,9 +141,12 @@         res @?= ("KEY", Float ( -44.88 ))      it "should parse a logical constant" $ do-        res <- parse parseKeywordValue "KEY=     T " -        res @?= ("KEY", Logic T)+        res <- parse parseKeywordValue "KEYT=     T "+        res @?= ("KEYT", Logic T) +        res <- parse parseKeywordValue "KEYF=     F "+        res @?= ("KEYF", Logic F)+     it "should ignore comments" $ do         res <- parse parseKeywordValue "SIMPLE  =                    T / conforms to FITS standard"          res @?= ("SIMPLE", Logic T)@@ -149,55 +159,100 @@ fullRecord = describe "parseKeywordRecord" $ do     it "should parse an 80 character record" $ do       res <- parse parseKeywordRecord (flattenKeywords ["KEYWORD = 12345"])-      res @?= ("KEYWORD", Integer 12345)+      res @?= KeywordRecord "KEYWORD" (Integer 12345) Nothing      it "should parse an a record and comment" $ do       res <- parse parseKeywordRecord (flattenKeywords ["KEYWORD = 12345 / this is a comment"])-      res @?= ("KEYWORD", Integer 12345)+      res @?= KeywordRecord "KEYWORD" (Integer 12345) (Just "this is a comment")      it "should parse a record, comment, followed by next keyword" $ do       res <- parse parseKeywordRecord $ flattenKeywords ["SIMPLE  =                    T / conforms to FITS standard"]-      res @?= ("SIMPLE", Logic T)+      res @?= KeywordRecord "SIMPLE" (Logic T) (Just "conforms to FITS standard")      it "should handle keyword symbols" $ do       res <- parse parseKeywordRecord $ flattenKeywords ["OBSGEO-X=   -5466045.256954942 / [m]"]-      res @?= ("OBSGEO-X", Float (-5466045.256954942))+      res @?= KeywordRecord "OBSGEO-X" (Float (-5466045.256954942)) (Just "[m]")      it "should handle extension" $ do       res <- parse parseKeywordRecord $ flattenKeywords ["XTENSION= 'IMAGE   '"]-      res @?= ("XTENSION", String "IMAGE")+      res @?= KeywordRecord "XTENSION" (String "IMAGE") Nothing +    it "should not consume blank lines" $ do+        let inp = flattenKeywords ["SIMPLE  =                    T" , " "]+        res <- flip parse inp $ do+          kv <- parseKeywordRecord+          _ <- parseLineBlank+          pure kv+        res @?= KeywordRecord "SIMPLE" (Logic T) Nothing ++ fullRecordLine :: Test () fullRecordLine = describe "parseRecordLine" $ do     it "should parse a normal line" $ do       res <- parse parseRecordLine "NAXIS1  =                  100 / [pix]                                          END"-      res @?= Just ("NAXIS1", Integer 100)+      res @?= Keyword (KeywordRecord "NAXIS1" (Integer 100) (Just "[pix]"))      it "should parse a comment line" $ do       res <- parse parseRecordLine "COMMENT ------------------------------ Telescope -------------------------------END"-      res @?= Nothing+      res @?= Comment "------------------------------ Telescope -------------------------------"      it "should parse a blank line" $ do       res <- parse parseRecordLine $ flattenKeywords [" "]-      res @?= Nothing+      res @?= BlankLine   comments :: Test ()-comments = describe "Full-line comments" $ do+comments = do+  describe "Full-line comments" $ do     it "should parse full-line comments" $ do       res <- parse parseLineComment $ flattenKeywords ["COMMENT --------------------------- VISP Instrument ----------------------------"]-      res @?= Comment "--------------------------- VISP Instrument ----------------------------"+      res @?= "--------------------------- VISP Instrument ----------------------------"      it "should parse comments with text" $ do       res <- parse parseLineComment $ flattenKeywords ["COMMENT  Keys describing the pointing and operation of the telescope. Including "]-      res @?= Comment " Keys describing the pointing and operation of the telescope. Including "+      res @?= " Keys describing the pointing and operation of the telescope. Including "      it "should parse blank comments" $ do       res <- parse parseLineComment $ flattenKeywords ["COMMENT                                                                         "]-      res @?= Comment "                                                                        "+      res @?= "                                                                        "+  +  describe "inline comments" $ do+    it "should parse comment" $ do+      res <- parse (parseInlineComment 0) $ " / Telescope" <> C8.replicate 68 ' '+      res @?= "Telescope" +  describe "parse to line end" $ do+    it "should parse comment line end" $ do+      res <- parse (parseLineEnd 0) $ " / Telescope" <> C8.replicate 68 ' '+      res @?= Just "Telescope" +    it "should ignore blanks" $ do+      res <- parse (parseLineEnd 0) $ C8.replicate 80 ' '+      res @?= Nothing++    it "should parse comment after blanks" $ do+      res <- parse (parseLineEnd 0) $ "          / comment " <> C8.replicate 60 ' '+      res @?= Just "comment"++  describe "withComments" $ do+    it "should parse a number, ignoring" $ do+      res <- parse (withComments parseValue) $ "12345 / Woot" <> C8.replicate 68 ' '+      res @?= (Integer 12345, Just "Woot")+    +    it "should parse no comment" $ do+      res <- parse (withComments parseValue) $ "12345       " <> C8.replicate 68 ' '+      res @?= (Integer 12345, Nothing)++    it "should ignore comments on bintable" $ do+      -- parse (withComments parseValue) $ "12345       " <> C8.replicate 68 ' '+      let inp = flattenKeywords ["XTENSION= 'BINTABLE'           / binary table extension"]+      (_, mc) <- flip parse inp $ do+        withComments $ M.string' "XTENSION= 'BINTABLE'"+      mc @?= Just "binary table extension"+++ continue :: Test () continue = describe "Continue Keyword" $ do @@ -210,45 +265,51 @@               , "CONTINUE  'ml'                                                                  "               ] -      m <- parse parseHeader $ flattenKeywords h-      Map.lookup "CAL_URL" m @?= Just (String "https://docs.dkist.nso.edu/projects/visp/en/v2.0.1/l0_to_l1_visp.html")+      h <- parse parseHeader $ flattenKeywords h+      Fits.lookup "CAL_URL" h @?= Just (String "https://docs.dkist.nso.edu/projects/visp/en/v2.0.1/l0_to_l1_visp.html")   headerMap :: Test () headerMap = describe "full header" $ do     it "should parse single header" $ do-        res <- parse parseHeader $ flattenKeywords ["KEY1='value'"]-        Map.size res @?= 1-        Map.lookup "KEY1" res @?= Just (String "value")+        h <- parse parseHeader $ flattenKeywords ["KEY1='value'"]+        length (h ^. keywords) @?= 1+        Fits.lookup "KEY1" h @?= Just (String "value")      it "should parse multiple headers " $ do         res <- parse parseHeader $ flattenKeywords ["KEY1='value'", "KEY2=  23"]-        Map.size res @?= 2-        Map.lookup "KEY2" res @?= Just (Integer 23)+        length (res ^.  keywords) @?= 2+        Fits.lookup "KEY2" res @?= Just (Integer 23)      it "should ignore comments" $ do         res <- parse parseHeader $ flattenKeywords ["KEY1='value' / this is a comment"]-        Map.size res @?= 1-        Map.lookup "KEY1" res @?= Just (String "value")+        length (res ^. keywords) @?= 1+        Fits.lookup "KEY1" res @?= Just (String "value")      it "should handle xtension" $ do         res <- parse parseHeader $ flattenKeywords ["XTENSION= 'IMAGE   '"]-        Map.size res @?= 1-        Map.lookup "XTENSION" res @?= Just (String "IMAGE")+        length (res ^. keywords) @?= 1+        Fits.lookup "XTENSION" res @?= Just (String "IMAGE") +    it "should parse blank line before keyword" $ do+        res <- parse parseHeader $ flattenKeywords [" ", "KEY2    = 22"]+        (res ^. records) @?= [BlankLine, Keyword (KeywordRecord "KEY2" (Integer 22) Nothing)]+        +    it "should parse line after keyword" $ do+        res <- parse parseHeader $ flattenKeywords ["KEY1    = 11", " ", "KEY2    = 22"]+        (res ^. records) @?= [Keyword (KeywordRecord "KEY1" (Integer 11) Nothing), BlankLine, Keyword (KeywordRecord "KEY2" (Integer 22) Nothing)] -requiredHeaders :: Test ()-requiredHeaders = describe "required headers" $ do -    --   res <- parse parseSimple $ keywords ["SIMPLE=    T"]-    --   res @?= Primary +requiredHeaders :: Test ()+requiredHeaders =+  describe "required headers" $ do     it "should parse bitpix" $ do       res <- parse parseBitPix $ flattenKeywords ["BITPIX = 16"]       res @?= SixteenBitInt -    it "should parse NAxes" $ do-      res <- parse parseNaxes $ flattenKeywords ["NAXIS = 3", "NAXIS1=1", "NAXIS2=2", "NAXIS3=3"]+    it "should parse NAXES" $ do+      res <- parse parseNaxes $ flattenKeywords ["NAXIS   =3", "NAXIS1  =1", "NAXIS2  =2", "NAXIS3  =3"]       res @?= [1,2,3]      it "should parse size" $ do@@ -260,8 +321,8 @@       let fakeData = "1234" -- Related to NAXIS!       h <- parse parsePrimary $ flattenKeywords ["SIMPLE = T", "BITPIX = 8", "NAXIS=2", "NAXIS1=2", "NAXIS2=2", "TEST='hi'"] <> fakeData       (h ^. extension) @?= Primary-      Map.size (h ^. header . keywords) @?= 5-      Fits.lookup "NAXIS" (h ^. header) @?= Just (Integer 2) +      length (h ^. header . keywords) @?= 5+      lookup "NAXIS" (h ^. header) @?= Just (Integer 2)       it "should parse full extension" $ do       h <- parse parseBinTable $ flattenKeywords ["XTENSION= 'BINTABLE'", "BITPIX = -32", "NAXIS=0", "PCOUNT=0", "GCOUNT=1"]@@ -284,7 +345,7 @@       hdu <- eitherFail $ readPrimaryHDU bs       -- hdu.header.size.bitpix @?= ThirtyTwoBitFloat       -- hdu.header.size.naxes @?= NAxes [621, 621]-      --+        Fits.lookup "NAXIS" (hdu ^. header) @?= Just (Integer 2)         let payloadSize = BS.length (hdu ^. mainData)@@ -304,8 +365,8 @@               , "COMMENT  Keys describing the pointing and operation of the telescope. Including "               , "COMMENT     the FITS WCS keys describing the world coordinates of the array.    "               ]-      m <- parse parseHeader $ flattenKeywords h-      Map.size m @?= 1+      h <- parse parseHeader $ flattenKeywords h+      length (h ^. keywords) @?= 1       describe "sample header file" $ do@@ -317,7 +378,11 @@           _ <- parse parseRecordLine $ flattenKeywords [TE.encodeUtf8 t]           pure () -      it "should parse NAxes correctly" $ do+      it "should parse xtension bintable" $ do+          (sz, _) <- parse parseBinTableKeywords $ mconcat $ C8.lines bs+          (sz ^. axes) @?= [32, 998]++      it "should parse NAXES correctly" $ do         (sz, _) <- parse parseBinTableKeywords $ mconcat $ C8.lines bs         (sz ^. axes) @?= [32, 998]