{-# LANGUAGE QuasiQuotes #-}
module Data.Aeson.Generics.TypeScript.PrintSpec
( main
, spec
) where
import Data.Aeson.Generics.TypeScript
( TSGenericVar
, TypeScriptDefinition (..)
, printTS
)
import Data.Aeson.Generics.TypeScript.Types
( CouldBe
, GenericRecordInSum
, GotTime
, HasEither
, ItsEnum
, ItsRecord
, ItsRecordWithGeneric
, NewIdentity
, Prod
, RecordWithWrappedType
, Sum
, Unit
, definedIn
)
import Data.String.Interpolate (i)
import Test.Hspec (Spec, hspec, it, shouldBe)
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
it "Unit" $ printTS (gen @Unit) `shouldBe`
[i|// #{definedIn}
type Unit = [];|]
it "GotTime" $ printTS (gen @GotTime) `shouldBe`
[i|// #{definedIn}
interface GotTime {
// readonly tag: "GotTime";
readonly unGotTime: string;
}|]
it "CouldeBe a" $ printTS (gen @(CouldBe (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
type CouldBe = ForSure | Nah;
interface ForSure {
readonly tag: "ForSure";
readonly contents: A;
}
interface Nah {
readonly tag: "Nah";
}|]
it "CouldeBe Int" $ printTS (gen @(CouldBe Int)) `shouldBe`
[i|// #{definedIn}
type CouldBe = ForSure | Nah;
interface ForSure {
readonly tag: "ForSure";
readonly contents: number;
}
interface Nah {
readonly tag: "Nah";
}|]
it "Sum () String" $ printTS (gen @(Sum () String)) `shouldBe`
[i|// #{definedIn}
type Sum = Foyst | Loser;
interface Foyst {
readonly tag: "Foyst";
readonly contents: [];
}
interface Loser {
readonly tag: "Loser";
readonly contents: string;
}|]
it "Sum a b" $ printTS (gen @(Sum (TSGenericVar "a") (TSGenericVar "b"))) `shouldBe`
[i|// #{definedIn}
type Sum = Foyst | Loser;
interface Foyst {
readonly tag: "Foyst";
readonly contents: A;
}
interface Loser {
readonly tag: "Loser";
readonly contents: B;
}|]
it "Sum a a" $ printTS (gen @(Sum (TSGenericVar "a") (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
type Sum = Foyst | Loser;
interface Foyst {
readonly tag: "Foyst";
readonly contents: A;
}
interface Loser {
readonly tag: "Loser";
readonly contents: A;
}|]
it "Prod a b" $ printTS (gen @(Prod (TSGenericVar "a") (TSGenericVar "b") (TSGenericVar "c"))) `shouldBe`
[i|// #{definedIn}
type Prod = [A, B, C];|]
it "Prod a a" $ printTS (gen @(Prod (TSGenericVar "a") (TSGenericVar "a") (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
type Prod = [A, A, A];|]
it "ItsEnum" $ printTS (gen @ItsEnum) `shouldBe`
[i|// #{definedIn}
type ItsEnum = "One" | "Two" | "Three";|]
it "ItsRecord" $ printTS (gen @ItsRecord) `shouldBe`
[i|// #{definedIn}
interface ItsRecord {
// readonly tag: "MkItsRecord";
readonly oneThing: number;
readonly twoThing: string;
readonly threeThing: [];
}|]
it "ItsRecordWithGeneric" $ printTS (gen @(ItsRecordWithGeneric (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
interface ItsRecordWithGeneric {
// readonly tag: "MkItsRecordWithGeneric";
readonly oneThing: number;
readonly twoThing: string | null;
readonly threeThing: A;
}|]
it "RecordWithWrappedType" $ printTS (gen @RecordWithWrappedType) `shouldBe`
[i|// #{definedIn}
interface RecordWithWrappedType {
// readonly tag: "RecordWithWrappedType";
readonly oneThing: number;
readonly twoThing: Array;
}|]
it "GenericRecordInSum" $ printTS (gen @(GenericRecordInSum (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
type GenericRecordInSum = OtherThing | MkGenericRecordInSum;
interface OtherThing {
readonly tag: "OtherThing";
}
interface MkGenericRecordInSum {
readonly tag: "MkGenericRecordInSum";
readonly oneThing: number;
readonly twoThing: Array;
}|]
it "HasEither" $ printTS (gen @HasEither) `shouldBe`
[i|// #{definedIn}
interface HasEither {
// readonly tag: "HasEither";
readonly notTheEither: number;
readonly theEither: { Left: string } | { Right: boolean };
}|]
it "NewIdentity" $ printTS (gen @(NewIdentity (TSGenericVar "a"))) `shouldBe`
[i|// #{definedIn}
type NewIdentity = A;|]