content: module Test.Fits.ClassSpec where
  
  import Control.Monad.Catch (throwM)
  import Data.Text (Text)
  import Effectful
  import Effectful.Error.Static
  import GHC.Generics
  import Skeletest
  import Skeletest.Predicate qualified as P
  import Telescope.Data.Axes
  import Telescope.Data.Parser
  import Telescope.Data.WCS
  import Telescope.Fits.Header
  
  
  spec :: Spec
  spec = do
    describe "class" classSpec
    describe "wcs" wcsSpec
  
  
  newtype Activity = Activity Text
    deriving newtype (FromKeyword, ToKeyword)
  
  
  data Test = Test
    { age :: Int
    , firstName :: Text
    }
    deriving (Generic, ToHeader, FromHeader)
  
  
  data Woot = Woot
    { woot :: Float
    }
    deriving (Generic, ToHeader)
  
  
  data Parent = Parent
    { test :: HeaderFor Test
    , woot :: HeaderFor Woot
    }
    deriving (Generic, ToHeader)
  
  
  classSpec :: Spec
  classSpec = do
    describe "To/From KeywordValue" $ do
      it "should toKeywordValue" $ do
        toKeywordValue (23 :: Int) `shouldBe` Integer 23
        toKeywordValue ("hello" :: Text) `shouldBe` String "hello"
        toKeywordValue True `shouldBe` Logic T
  
      it "should parseKeywordValue" $ do
        runParserPure (parseKeywordValue @Int $ Integer 23) `shouldBe` Right 23
        runParserPure (parseKeywordValue @Text $ String "woot") `shouldBe` Right "woot"
        runParserPure (parseKeywordValue @Bool $ Logic F) `shouldBe` Right False
  
    describe "ToHeader" $ do
      it "should uppercase and snake keywords" $ do
        let h = toHeader (Test 40 "Alice")
        length h.records `shouldBe` 2
        [Keyword (KeywordRecord k1 _ _), Keyword (KeywordRecord k2 _ _)] <- pure h.records
        k1 `shouldBe` "AGE"
        k2 `shouldBe` "FIRST_NAME"
  
      it "should convert datatype" $ do
        let h = toHeader (Test 40 "Alice")
        lookupKeyword "AGE" h `shouldBe` Just (Integer 40)
        lookupKeyword "FIRST_NAME" h `shouldBe` Just (String "Alice")
  
    it "should mconcat fields that are members of toHeader" $ do
      let h = toHeader $ Parent (HeaderFor $ Test 40 "Alice") (HeaderFor $ Woot 123.456)
      lookupKeyword "age" h `shouldBe` Just (Integer 40)
      lookupKeyword "first_name" h `shouldBe` Just (String "Alice")
      lookupKeyword "woot" h `shouldSatisfy` P.just (P.con (Float (P.approx P.tol 123.456)))
  
    describe "FromHeader" $ do
      it "should convert datatype" $ do
        let h = toHeader (Test 40 "Alice")
        let et = runParserPure $ parseHeader h
        et `shouldSatisfy` P.right (P.con Test{age = P.eq 40})
        et `shouldSatisfy` P.right (P.con Test{firstName = P.eq "Alice"})
  
  
  data X
  instance AxisOrder X where
    axisN = 1
  
  
  data Y
  instance AxisOrder Y where
    axisN = 2
  
  
  wcsSpec :: Spec
  wcsSpec = do
    describe "axis To/From Header" $ do
      it "should incorporate axis order into keywords" $ do
        let hx = toHeader wcsX
        lookupKeyword "CRPIX1" hx `shouldBe` Just (Float 1.0)
  
      it "should incorporate wcsalt into keywords" $ do
        let h = toHeader wcsAY
        lookupKeyword "CRVAL2A" h `shouldBe` Just (Float 5.0)
  
      it "should roundtrip" $ do
        let h = toHeader wcsAY
        wcs2 <- parseIO $ parseHeader h
        wcs2 `shouldBe` wcsAY
   where
    wcsX = WCSAxis (CType "X") (CUnit "M") 1 2 3 :: WCSAxis 'WCSMain X
    wcsAY = WCSAxis (CType "Y") (CUnit "M") 4 5 6 :: WCSAxis 'A Y
  
  
  parseIO :: Eff '[Parser, Error ParseError, IOE] a -> IO a
  parseIO p = do
    res <- runEff $ runErrorNoCallStack @ParseError $ runParser p
    case res of
      Left e -> throwM e
      Right a -> pure a
  