{-# LANGUAGE QuasiQuotes #-} module Data.Aeson.Generics.TypeScript.AesonSpec ( main , spec ) where import Control.Monad (when) import Data.Aeson (encode) import Data.Aeson.Generics.TypeScript ( TSGenericVar , TypeScriptDefinition (..) , printTS ) import Data.Aeson.Generics.TypeScript.Types ( CouldBe (ForSure) , GenericRecordInSum (MkGenericRecordInSum) , GotTime (..) , HasEither (HasEither) , ItsEnum (Two) , ItsRecord (MkItsRecord) , ItsRecordWithGeneric (MkItsRecordWithGeneric) , MapParty (..) , NewIdentity (..) , NewString (MkNewString) , Prod (..) , RecordWithWrappedType (RecordWithWrappedType) , Sum (Foyst) , Unit (..) ) import Data.ByteString.Lazy.Char8 (unpack) import Data.List.Split (splitOn) import Data.Map (Map) import qualified Data.Map as Map import Data.String.Interpolate (i) import Data.Time.Clock (getCurrentTime) import System.Directory (getTemporaryDirectory, removeFile) import System.Exit (ExitCode (ExitFailure)) import System.FilePath ((<.>), ()) import System.Process (readProcessWithExitCode) import System.Random (randomIO) import Test.Hspec (Spec, hspec, it, parallel, runIO) main :: IO () main = hspec spec spec :: Spec spec = parallel do utcTime <- runIO getCurrentTime it "Unit" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @Unit) encoded = unpack (encode MkUnit) typeName = "Unit" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "CouldBe a" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(CouldBe (TSGenericVar "a"))) encoded = unpack (encode $ ForSure ()) typeName = "CouldBe<[]>" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "GOTTime" . shouldSatisfyTypeScriptCompiler $ let encoded = unpack (encode $ GotTime utcTime) typeDecl = printTS (gen @GotTime) typename = "GotTime" :: String in [i|#{typeDecl} const sample : #{typename} = #{encoded};|] it "Sum a b" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(Sum (TSGenericVar "a") (TSGenericVar "b"))) encoded = unpack (encode (Foyst 3 :: Sum Int String)) typeName = "Sum" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "Sum a a" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(Sum (TSGenericVar "a") (TSGenericVar "a"))) encoded = unpack (encode (Foyst 3 :: Sum Int Int)) typeName = "Sum" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "Prod a a a" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(Prod (TSGenericVar "a") (TSGenericVar "a") (TSGenericVar "a"))) encoded = unpack (encode (MkProd 3 4 5 :: Prod Int Int Int)) typeName = "Prod" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "ItsEnum" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @ItsEnum) encoded = unpack (encode Two) typeName = "ItsEnum" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "ItsRecord" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @ItsRecord) encoded = unpack (encode $ MkItsRecord 3 "wat" ()) typeName = "ItsRecord" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "ItsRecordWithGeneric Just" $ do let typeDecl = printTS (gen @(ItsRecordWithGeneric (TSGenericVar "a"))) encoded = unpack (encode $ MkItsRecordWithGeneric 3 (Just "foo") ()) typeName = "ItsRecordWithGeneric<[]>" :: String thang = [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] shouldSatisfyTypeScriptCompiler thang it "ItsRecordWithGeneric Nothing" $ do let typeDecl = printTS (gen @(ItsRecordWithGeneric (TSGenericVar "a"))) encoded = unpack (encode $ MkItsRecordWithGeneric 3 Nothing ()) typeName = "ItsRecordWithGeneric<[]>" :: String thang = [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] shouldSatisfyTypeScriptCompiler thang it "GenericRecordInSum" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(GenericRecordInSum (TSGenericVar "a"))) encoded = encode $ MkGenericRecordInSum 3 ["foo" :: String,"bar"] typeName = "GenericRecordInSum" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "RecordWithWrappedType" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @RecordWithWrappedType) encoded = encode $ RecordWithWrappedType 3 [MkNewString "foo", MkNewString "bar"] typeName = "RecordWithWrappedType" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "NewIdentity" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(NewIdentity (TSGenericVar "a"))) encoded = encode (NewIdentity 3 :: NewIdentity Int) typeName = "NewIdentity" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "MapParty Int String" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(MapParty Int String)) encoded = encode $ MapParty (Map.fromList [(1,"foo"),(2,"bar"),(10,"baz")] :: Map Int String) typeName = "MapParty" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "MapParty a b" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(MapParty (TSGenericVar "a") (TSGenericVar "b"))) encoded = encode $ MapParty (Map.fromList [(1,"foo"),(2,"bar"),(10,"baz")] :: Map Int String) typeName = "MapParty" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "MapParty memtpy" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @(MapParty (TSGenericVar "a") (TSGenericVar "b"))) encoded = encode $ MapParty (Map.fromList [(3,"what"),(7,"frog"),(12,"wat")] :: Map Int String) typeName = "MapParty" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "HasEither Left" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @HasEither) encoded = encode . HasEither 3 $ Left "foo" typeName = "HasEither" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] it "HasEither Right" . shouldSatisfyTypeScriptCompiler $ let typeDecl = printTS (gen @HasEither) encoded = encode . HasEither 3 $ Right True typeName = "HasEither" :: String in [i|#{typeDecl} const sample : #{typeName} = #{encoded};|] showLineNumbers :: Bool showLineNumbers = True shouldSatisfyTypeScriptCompiler :: String -> IO () shouldSatisfyTypeScriptCompiler ts = do tmpDir :: FilePath <- getTemporaryDirectory now <- getCurrentTime rand <- randomIO :: IO Int let filePath = tmpDir show now <> show (rand * 1000000) <.> "ts" writeFile filePath ts res <- readProcessWithExitCode "tsc" [filePath, "--outFile", filePath <.> "js" ] "" removeFile filePath removeFile $ filePath <.> "js" case res of (ExitFailure ef, out, err) -> do putStrLn "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━" putStrLn $ addLineNumbers ts putStrLn "┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈┈" putStrLn out when (not (null err)) $ putStrLn err putStrLn "━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━" error $ "TSC exited with " <> show ef _ -> return () addLineNumbers :: String -> String addLineNumbers ts = if showLineNumbers then foldMap (\(x,ln) -> let lnf = show (ln :: Int) in "\n " <> lnf <> replicate (4 - length lnf) ' ' <> "|" <> x) $ zip (splitOn "\n" ts) [1..] else ts