predicate-typed-0.7.4.2: test/TestJson.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NoStarIsType #-}
module TestJson where
--module TestJson (suite) where
import TastyExtras
import Test.Tasty
import Test.Tasty.HUnit
import Predicate
import qualified Predicate.Refined as R
import qualified Predicate.Refined3 as R3
import qualified Predicate.Examples.Refined3 as R3
import GHC.Generics (Generic)
import Data.Text (Text)
import Data.Aeson
import qualified Data.ByteString as BS
import Control.Lens
import qualified Safe (readNote)

suite :: TestTree
suite = testGroup "testjson"
  [ testCase "testperson ok" $ expectIO testPerson (() <$)
  , testCase "testperson1 ok" $ expectIO (testPerson1 @OAN 2) (() <$)
  , testCase "testperson1 bad ipaddress" $ expectIO (testPerson1 @OAN 3) (expectLeftWith ["octet 3 out of range 0-255 found 260"])
  , testCase "testperson1 bad lastname lowercase first letter" $ expectIO (testPerson1 @OAN 4) (expectLeftWith ["lastName1", "invalid name", "diaz"])
  , testCase "testperson1 bad first name lowercase first letter" $ expectIO (testPerson1 @OAN 6) (expectLeftWith ["firstName1", "not upper first(d)"])
  , testCase "testperson1 age 99 out of range" $ expectIO (testPerson1 @OAN 5) (expectLeftWith ["Error in $[0].age1"])
  , testCase "parse fail person1" $ expectBT (Fail "ParseJsonFile [Person1 'OZ](test3.json) Error in $[0].ipaddress1: Refined3(FromJSON:parseJSON):Step 2. Failed Boolean Check(op) | octet 3 out of range 0-255 found 260") $ pz @(ParseJsonFile [Person1 'OZ] "test3.json") ()
  , testCase "parse ok person1" $ expectBT (Val 5) $ pl @(ParseJsonFile [Person1 OAN] "test2.json" >> Len) ()
  , testCase "missing file" $ expectBT (Fail "ParseJsonFile [Person1 'OZ](test2.jsoxxxn) file does not exist") $ pl @(ParseJsonFile [Person1 'OZ] "test2.jsoxxxn" >> Len) ()

  , testCase "getRow2Age1" $ do
                           x <- pz @(ParseJsonFile [Person1 OAN] "test2.json" >> Id !! 2) ()
                           (x ^? _Val . to (unRefined . age1)) @?= Just 45
                           (x ^? _Val . to (R3.r3Out . ipaddress1)) @?= Just "124.001.012.223"
  , testCase "getRow2" $ do
                           x <- pz @(ParseJsonFile [Person1 OAN] "test2.json" >> Id !! 2) ()
                           x @?= Val (Person1 {firstName1 = unsafeRefined "John", lastName1 = unsafeRefined "Doe", age1 = unsafeRefined 45, likesPizza1 = False, date1 = R3.unsafeRefined3 (Safe.readNote "testjson: utc date" "2003-01-12 04:05:33 UTC") "2003-01-12 04:05:33", ipaddress1 = R3.unsafeRefined3 [124,1,12,223] "124.001.012.223"})
  ]

testPerson :: IO (Either String [Person])
testPerson = eitherDecodeStrict' <$> BS.readFile "test1.json"

testPerson1 :: forall opts . OptC opts => Int -> IO (Either String [Person1 opts])
testPerson1 i = do
  let fn = "test" ++ show i ++ ".json"
  eitherDecodeStrict' <$> BS.readFile fn

data Person = Person {
       firstName :: !Text
     , lastName :: !Text
     , age :: !Int
     , likesPizza :: !Bool
     } deriving (Show,Generic,Eq)

instance ToJSON Person
instance FromJSON Person

data Person1 (opts :: Opt) = Person1 {
       firstName1 :: !(NameR2 (opts ':# 'OMsg "person1 firstname1"))
     , lastName1 :: !(NameR1 (opts ':# 'OMsg "person1 lastname1"))
     , age1 :: !(AgeR (opts ':# 'OMsg "age1 errors"))
     , likesPizza1 :: !Bool
     , date1 :: !(R3.DateTimeNR (opts ':# 'OMsg "person date1"))
     , ipaddress1 :: !(R3.Ip4R (opts ':# 'OMsg "ipaddress1 errors"))
     } deriving (Show,Generic,Eq)

instance OptC opts => ToJSON (Person1 opts)
instance OptC opts => FromJSON (Person1 opts)

type NameR1 (opts :: Opt) = R.Refined opts Name1 String
type Name1 = Msg "invalid name:" (Re "^[A-Z][a-z']+$")

-- more specific messages
type NameR2 (opts :: Opt) = R.Refined opts Name2 String
type Name2 =
          Uncons
       >> Just'
       >> (Guard (PrintF "not upper first(%c)" Id) IsUpper
      *** Guard (PrintF "not lower rest(%s)" Id) IsLowerAll)
       >> 'True
{-
type NameR2' (opts :: Opt) = R.Refined opts Name2' String
type Name2' =
          Uncons
       >> Just'
       >> (Fst >> GuardBool (PrintF "not upper first(%c)" Id) IsUpper)
       && (Snd >> GuardBool (PrintF "not lower rest(%s)" Id) IsLowerAll)
-}
type AgeR (opts :: Opt) = R.Refined opts (Between 10 60 Id) Int