content: {-# LANGUAGE
      DeriveGeneric
    , FlexibleInstances
    , FlexibleContexts
    , DeriveAnyClass
    , ScopedTypeVariables
    , TypeApplications
    , DataKinds
    , TypeOperators
    , AllowAmbiguousTypes
    , DerivingVia
    #-}
  import Test.HUnit
  import ProjectM36.Tupleable.Deriving
  import ProjectM36.Atomable
  import ProjectM36.Attribute as A
  import ProjectM36.Error
  import ProjectM36.Base
  import Control.DeepSeq (NFData)
  import qualified Data.Vector as V
  import qualified Data.Map as M
  import qualified Data.Text as T
  import qualified Data.Set as S
  import System.Exit
  import Data.Proxy
  import Codec.Winery
  
  {-# ANN module ("Hlint: ignore Use newtype instead of data" :: String) #-}
  
  data Test1T = Test1C {
    attrA :: Integer
    }
    deriving (Generic, Eq, Show)
    deriving Serialise via WineryRecord Test1T
             
  data Test2T = Test2C {
    attrB :: Integer,
    attrC :: Integer
    }
    deriving (Generic, Eq, Show)
    deriving Serialise via WineryRecord Test2T
             
  data Test3T = Test3C Integer            
              deriving (Generic, Eq, Show)
              deriving Serialise via WineryVariant Test3T
                       
  data Test4T = Test4C                     
                deriving (Generic, Eq, Show)
                deriving Serialise via WineryVariant Test4T
                         
  data Test5T = Test5C1 Integer |                       
                Test5C2 Integer
                deriving (Generic, Eq, Show)
                deriving Serialise via WineryVariant Test5T
                         
  data Test6T = Test6C T.Text Integer Double
                deriving (Generic, Eq, Show)
                         
  data Test7A = Test7AC Integer
              deriving (Generic, Show, Eq, NFData, Atomable)
              deriving Serialise via WineryVariant Test7A
                         
                         
  data Test7T = Test7C Test7A                       
                deriving (Generic, Show, Eq)
                deriving Serialise via WineryVariant Test7T
                         
  data Test8T = Test8C                       
                deriving (Generic, Show, Eq)
                deriving Serialise via WineryVariant Test8T
                         
  data Test9T = Test9C 
                {                      
                  attr9A :: Integer,
                  attr9B :: T.Text,
                  attr9C :: Double
                }
              deriving (Generic, Show, Eq)
              deriving Serialise via WineryRecord Test9T
  
  data Test10T = Test10C {
    longAttrNameA10 :: Integer,
    long_attr_name_b10 :: Integer,
    longMixed_attr_NameC10 :: Integer
    }
    deriving (Generic, Show, Eq)
    deriving Serialise via WineryRecord Test10T
             
  instance Tupleable Test1T
  
  instance Tupleable Test2T
  
  instance Tupleable Test3T
  
  instance Tupleable Test4T
  
  --instance Tupleable Test5T -- should fail at compile time- sum types not supported
  
  instance Tupleable Test6T
  
  instance Tupleable Test7T
  
  instance Tupleable Test8T
  
  instance Tupleable Test9T
  
  main :: IO ()
  main = do
    tcounts <- runTestTT testList
    if errors tcounts + failures tcounts > 0 then exitFailure else exitSuccess
  
  testList :: Test
  testList = TestList [testADT1, testADT2, testADT3, testADT4, testADT6, testADT7, testADT8  ,testInsertExpr, testDefineExpr, testUpdateExpr, testUpdateExprEmptyAttrs, testDeleteExpr, testUpdateExprWrongAttr, testReorderedTuple, testAddPrefixField, testDropPrefixField, testAddSuffixField, testDropSuffixField, testUpperCaseField, testLowerCaseField, testTitleCaseField, testCamelCaseField, testPascalCaseField, testSnakeCaseField, testSpinalCaseField, testTrainCaseField, testAsIsCodec, testAsIsField, testComposeRLCodec, testComposeRLField, testComposeLRCodec, testComposeLRField]
  
  testADT1 :: Test
  testADT1 = TestCase $ assertEqual "one record constructor" (Right example) (fromTuple (toTuple example))
    where 
      example = Test1C {attrA = 3}
  
  testADT2 :: Test
  testADT2 = TestCase $ do
    let example = Test2C { attrB = 4, attrC = 6 }
    assertEqual "two record constructor" (Right example) (fromTuple (toTuple example))
    --this was a tricky case that was throwing the undefined exception because of insufficient laziness in the :*: matching- see ProjectM36.Tupleable
    let expectedAttributes = attributesFromList [Attribute "attrB" IntegerAtomType,
                                                 Attribute "attrC" IntegerAtomType]
    assertEqual "two record constructor toAttributes" expectedAttributes (toAttributes (Proxy :: Proxy Test2T))
    
      
  testADT3 :: Test
  testADT3 = TestCase $ assertEqual "one arg constructor" (Right example) (fromTuple (toTuple example))
    where
      example = Test3C 4
      
  testADT4 :: Test    
  testADT4 = TestCase $ assertEqual "zero arg constructor" (Right example) (fromTuple (toTuple example))
    where
      example = Test4C 
      
  --testADT5 should not compile    
      
  testADT6 :: Test    
  testADT6 = TestCase $ assertEqual "mixed types" (Right example) (fromTuple (toTuple example))
    where
      example = Test6C "testo" 3 4.0
      
  testADT7 :: Test    
  testADT7 = TestCase $ do
    let example = Test7C (Test7AC 3)
    assertEqual "atom type" (Right example) (fromTuple (toTuple example))
    let expectedAttrs = A.singleton (Attribute "" (ConstructedAtomType "Test7A" M.empty))
    assertEqual "adt atomtype" expectedAttrs (toAttributes (Proxy :: Proxy Test7T))
      
  testADT8 :: Test    
  testADT8 = TestCase $ assertEqual "single value" (Right example) (fromTuple (toTuple example))
    where
      example = Test8C
      
  testInsertExpr :: Test    
  testInsertExpr = TestCase $ assertEqual "insert expr" expected (toInsertExpr [Test9C {
                                                                                   attr9A = 4, 
                                                                                   attr9B = "a", 
                                                                                   attr9C = 3.4}] "rv")
    where expected = Right (Insert "rv" (MakeStaticRelation attrs tuples))
          attrs = attributesFromList [Attribute "attr9A" IntegerAtomType,
                                      Attribute "attr9B" TextAtomType,
                                      Attribute "attr9C" DoubleAtomType]
          tuples = RelationTupleSet [RelationTuple attrs (V.fromList [IntegerAtom 4,
                                                                      TextAtom "a",
                                                                      DoubleAtom 3.4])]
                   
  testDefineExpr :: Test                 
  testDefineExpr = TestCase $ assertEqual "define expr" expected actual
    where
      expected = Define "rv" (map NakedAttributeExpr attrs)
      attrs = [Attribute "attr9A" IntegerAtomType,
               Attribute "attr9B" TextAtomType,
               Attribute "attr9C" DoubleAtomType]
      actual = toDefineExpr (Proxy :: Proxy Test9T) "rv"
      
  testUpdateExpr :: Test    
  testUpdateExpr = TestCase $ do
    let expected = Right (Update "rv" updateMap restriction)
        updateMap = M.fromList [("attr9B", NakedAtomExpr (TextAtom "b")),
                                ("attr9C", NakedAtomExpr (DoubleAtom 5.5))]
        restriction = AttributeEqualityPredicate "attr9A" (NakedAtomExpr (IntegerAtom 5))
        actual = toUpdateExpr "rv" ["attr9A"] Test9C {attr9A = 5,
                                                       attr9B = "b",
                                                       attr9C = 5.5}
                                                                
    assertEqual "update expr1" expected actual
    
  testUpdateExprEmptyAttrs :: Test  
  testUpdateExprEmptyAttrs = TestCase $ do
    let expected = Left EmptyAttributesError
        actual = toUpdateExpr "rv" [] Test9C {attr9A = 5,
                                               attr9B = "b",
                                               attr9C = 5.5}
    assertEqual "update with empty attrs" expected actual
    
  testUpdateExprWrongAttr :: Test  
  testUpdateExprWrongAttr = TestCase $ do
    --currently, passing in the wrong attribute replaces the whole relvar with a single tuple- is this what we want?
    let expected = Left (NoSuchAttributeNamesError (S.singleton "nonexistentattr"))
        actual = toUpdateExpr "rv" ["nonexistentattr"] Test9C {attr9A = 5,
                                                                attr9B = "b",
                                                                attr9C = 5.5}
    assertEqual "update with wrong attr" expected actual               
    
  testDeleteExpr :: Test  
  testDeleteExpr = TestCase $ do
    let expected = Right (Delete "rv" (AndPredicate (AttributeEqualityPredicate "attr9A" 
                                              (NakedAtomExpr (IntegerAtom 5)))
                                             (AttributeEqualityPredicate "attr9B"
                                              (NakedAtomExpr (TextAtom "b")))))
        actual = toDeleteExpr "rv" ["attr9A", "attr9B"] Test9C {attr9A = 5,
                                                                 attr9B = "b",
                                                                 attr9C = 5.5}
    assertEqual "delete expr" expected actual
                                
  --discovered in #184 by ruhatch    
  testReorderedTuple :: Test
  testReorderedTuple = TestCase $ do
    let tupleRev :: RelationTuple -> RelationTuple
        tupleRev (RelationTuple v1 v2) = RelationTuple (revAttrs v1) (V.reverse v2)
        revAttrs attrs = A.attributesFromList (reverse (A.toList attrs))
        expected = Test2C {attrB = 3, 
                           attrC = 4}
        actual = fromTuple . tupleRev . toTuple $ expected
    assertEqual "reordered tuple" (Right expected) actual
  
  testCodec :: forall tag. ModifyOptions tag => String -> [AttributeName] -> Test
  testCodec msg expected = TestCase $
      assertEqual msg (S.fromList expected) actual
    where
      actual = attributeNameSet $ toAttributes (Proxy :: Proxy (Codec tag Test10T))
  
  testAddPrefixField :: Test
  testAddPrefixField = testCodec
    @(Field (AddPrefix "prefix_"))
    "codec field add prefix attributes"
    ["prefix_longAttrNameA10",
     "prefix_long_attr_name_b10",
     "prefix_longMixed_attr_NameC10"]
  
  testDropPrefixField :: Test
  testDropPrefixField = testCodec
    @(Field (DropPrefix "long"))
    "codec field drop prefix"
    ["AttrNameA10",
     "_attr_name_b10",
     "Mixed_attr_NameC10"]
  
  testAddSuffixField :: Test
  testAddSuffixField = testCodec
    @(Field (AddSuffix "_suffix"))
    "codec field add suffix"
    ["longAttrNameA10_suffix",
     "long_attr_name_b10_suffix",
     "longMixed_attr_NameC10_suffix"]
  
  testDropSuffixField :: Test
  testDropSuffixField = testCodec
    @(Field (DropSuffix "10"))
    "codec field drop suffix"
    ["longAttrNameA",
     "long_attr_name_b",
     "longMixed_attr_NameC"]
  
  testUpperCaseField :: Test
  testUpperCaseField = testCodec
    @(Field UpperCase)
    "codec field uppercase"
    ["LONGATTRNAMEA10",
     "LONG_ATTR_NAME_B10",
     "LONGMIXED_ATTR_NAMEC10"]
  
  testLowerCaseField :: Test
  testLowerCaseField = testCodec
    @(Field LowerCase)
    "codec field lowercase"
    ["longattrnamea10",
     "long_attr_name_b10",
     "longmixed_attr_namec10"]
  
  testTitleCaseField :: Test
  testTitleCaseField = testCodec
    @(Field TitleCase)
    "codec field title case"
    ["Long Attr Name A10",
     "Long Attr Name B10",
     "Long Mixed Attr Name C10"]
  
  testCamelCaseField :: Test
  testCamelCaseField = testCodec
    @(Field CamelCase)
    "codec field camel case"
    ["longAttrNameA10",
     "longAttrNameB10",
     "longMixedAttrNameC10"]
  
  testPascalCaseField :: Test
  testPascalCaseField = testCodec
    @(Field PascalCase)
    "codec field pascal case"
    ["LongAttrNameA10",
     "LongAttrNameB10",
     "LongMixedAttrNameC10"]
  
  testSnakeCaseField :: Test
  testSnakeCaseField = testCodec
    @(Field SnakeCase)
    "codec field snake case"
    ["long_attr_name_a10",
     "long_attr_name_b10",
     "long_mixed_attr_name_c10"]
  
  testSpinalCaseField :: Test
  testSpinalCaseField = testCodec
    @(Field SpinalCase)
    "codec field spinal case"
    ["long-attr-name-a10",
     "long-attr-name-b10",
     "long-mixed-attr-name-c10"]
  
  testTrainCaseField :: Test
  testTrainCaseField = testCodec
    @(Field TrainCase)
    "codec field train case"
    ["Long-Attr-Name-A10",
     "Long-Attr-Name-B10",
     "Long-Mixed-Attr-Name-C10"]
  
  testAsIsCodec :: Test
  testAsIsCodec = testCodec
    @AsIs
    "codec as is"
    ["longAttrNameA10",
     "long_attr_name_b10",
     "longMixed_attr_NameC10"]
  
  testAsIsField :: Test
  testAsIsField = testCodec
    @(Field AsIs)
    "codec field as is"
    ["longAttrNameA10",
     "long_attr_name_b10",
     "longMixed_attr_NameC10"]
  
  testComposeRLCodec :: Test
  testComposeRLCodec = testCodec
    @(Field UpperCase <<< Field (DropPrefix "long"))
    "codec (<<<)"
    ["ATTRNAMEA10",
     "_ATTR_NAME_B10",
     "MIXED_ATTR_NAMEC10"]
  
  testComposeRLField :: Test
  testComposeRLField = testCodec
    @(Field (UpperCase <<< DropPrefix "long"))
    "codec field (<<<)"
    ["ATTRNAMEA10",
     "_ATTR_NAME_B10",
     "MIXED_ATTR_NAMEC10"]
  
  testComposeLRCodec :: Test
  testComposeLRCodec = testCodec
    @(Field (DropPrefix "long") >>> Field UpperCase)
    "codec (>>>)"
    ["ATTRNAMEA10",
     "_ATTR_NAME_B10",
     "MIXED_ATTR_NAMEC10"]
  
  testComposeLRField :: Test
  testComposeLRField = testCodec
    @(Field (DropPrefix "long" >>> UpperCase))
    "codec field (>>>)"
    ["ATTRNAMEA10",
     "_ATTR_NAME_B10",
     "MIXED_ATTR_NAMEC10"]
  