auto-lift-classes-1: example/test.hs

{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE RoleAnnotations #-}
module Main where

import Data.Functor.Classes
import Text.Read

import AutoLift

data Test a = Test Int a [a]
    deriving (Show, Read, Eq)
    deriving (Show1, Read1) via (Reflected1 Test)

{-

-- The following does not compile due to type role annotation

data BadTest a = BadTest a [a]
    deriving (Show, Read, Eq)
    deriving (Show1, Read1) via (Reflected1 BadTest)

type role BadTest nominal

-}

test :: Test Char
test = Test 1 'a' "bcd"

testShow :: String
testShow = show test

testShow1 :: String
testShow1 = showsPrec1 0 test ""

readStr :: String
readStr = "Test 2 'e' \"fg\"   "

testRead :: [(Test Char, String)]
testRead = reads readStr

testRead1 :: [(Test Char, String)]
testRead1 = readsPrec1 0 readStr

data Crest a b = Crest Int [a] [b]
    deriving (Show, Read, Eq)
    deriving (Show1, Read1) via (Reflected1 (Crest a))
    deriving (Show2, Read2) via (Reflected2 Crest)

crest :: Crest Char Bool
crest = Crest 2 "foo" [False, True]

crestShow, crestShow1, crestShow2 :: String
crestShow = show crest
crestShow1 = showsPrec1 0 crest ""
crestShow2 = showsPrec2 0 crest ""

crestReadStr :: String
crestReadStr = "Crest 3 \"foo\" [True] rest of text"

crestRead, crestRead1, crestRead2 :: [(Crest Char Bool, String)]
crestRead = reads crestReadStr
crestRead1 = readsPrec1 0 crestReadStr
crestRead2 = readsPrec2 0 crestReadStr

main :: IO ()
main = putStrLn . unlines $
  [ "testShow:  " ++ show testShow
  , "testShow1: " ++ show testShow1
  , "testShow == testShow1: " ++ show (testShow == testShow1)
  , ""
  , "testRead:  " ++ show testRead
  , "testRead1: " ++ show testRead1
  , "testRead == testRead1: " ++ show (testRead == testRead1)
  , ""
  , "crestShow:  " ++ show crestShow
  , "crestShow1: " ++ show crestShow1
  , "crestShow2: " ++ show crestShow2
  , "crestShow == crestShow1: " ++ show (crestShow == crestShow1)
  , "crestShow == crestShow2: " ++ show (crestShow == crestShow2)
  , ""
  , "crestRead:  " ++ show crestRead
  , "crestRead1: " ++ show crestRead1
  , "crestRead2: " ++ show crestRead2
  , "crestRead == crestRead1: " ++ show (crestRead == crestRead1)
  , "crestRead == crestRead2: " ++ show (crestRead == crestRead2)
  ]