{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
module Test.Data.Values where

import           Control.DeepSeq
import           Control.Exception
import qualified Data.ByteString                as B
import qualified Data.ByteString.Lazy           as L
import qualified Data.ByteString.Short.Internal as SBS
import           Data.Char
import           Data.Flat
import           Data.Foldable
import           Data.Int
import           Data.List
import qualified Data.Map                       as M
import qualified Data.Sequence                  as Seq
import qualified Data.Text                      as T
import           Data.Word
import           Test.Data
import qualified Test.Data2                     as D2

instance NFData Various
instance NFData a => NFData (List a)
instance NFData a => NFData (D2.List a)
instance NFData N
instance NFData a => NFData (ListS a)
instance NFData a => NFData (Stream a)
instance NFData a => NFData (Tree a)
instance NFData Car
instance NFData Engine
instance NFData OptionalExtra
instance NFData CarModel
instance NFData Consumption
instance NFData Acceleration

floatT = ("float",-234.123123::Float)
doubleT = ("double",-1.91237::Double)

a01 = A0 B1 (B0 (C0 (A1 N N D2.Nil2 D2.Nil2))) (D0  E1)

ab0 = A (B (A (BB 'g')))

pe1 :: PerfectF Maybe Bool
pe1 = ConsP True (ConsP (Just False) (ConsP (Just (Just True)) NilP))

pr1 :: Pr Either List Int
pr1 = Pr (Right (C 3 N))
f1,f2,f3:: Free [] Int
f1 = Pure 1
f2 = Roll [Pure 1,Pure 2]
f3 = Roll [Roll [Pure 3],Pure 4]

rr1 :: RR Char () Int8
rr1 = RAB 'a' (RN 11 () 'b') ()

-- h = from Three
infList :: List Bool
infList = C True infList

hl1 = [1,3..111::Word]
hl2 = [1,3..111::Int]
hl3 = [False,True,True,False,True,True,True,True,False,True,True,True,True,False,True,False]

b1 = B.pack [99,173,186,44,187,124,87,186,104,99,138,202,53,137,22,5,44,244,234,7,159,119,22,234]
b2 = B.pack . concat . replicate 100 $ [235,7,135,117,255,69,100,113,113,82,128,181,200,146,155,228,144,65,83,162,130,236,235,7,135,117,255,69,100,113,113,82,128,181,200,146,155,228,144,65,83,162,130,236,235,7,135,117,255,69,100,113,113,82,128,181,200,146,155,228,144,65,83,162,130,236]

lb1 = L.pack . B.unpack $ b1
lb2 = L.fromChunks $ replicate 100 $ B.replicate 400 33

s1 = "a"
s2 = "中文版本"
s3 = ['A'..'z']
s4 = Prelude.concatMap show [1..400]

t1 = T.pack s1
t2 = T.pack s2
t3 = T.pack s3
t4 = T.pack s4


p1 :: Phantom Char
p1 = Phantom

--toList N = []
--toList (C h t) = h : (toList t)

l2L []     = N
l2L (x:xs) = C x (l2L xs)

l1 = l2L $ take 11 [11::Word8,22..33]

lBool :: List Bool
lBool = l2L $ map odd [1..99]

lBool2 :: List Bool
lBool2 = l2L $ map odd [1..1000]

lBool0 = C False (C True (C True (C False (C False (C False (C True (C False (C True (C False (C True (C True (C False (C False (C False N))))))))))))))

lN0 = C Three (C One N)

lN = C Three (C Three (C One (C One (C Three (C Four (C One (C Five (C Two (C Three (C Four (C Two (C Five (C Five (C Two (C Four (C Three (C One (C Four (C Five (C Two (C Five (C One (C Five (C Two (C One (C One (C Two (C Four N))))))))))))))))))))))))))))

largeSize = 1000000

couples :: [(Word32,N)]
couples = zip [1..] $ ns 1000

lN2 :: List N
lN2 = lnx 1000

lN3 = lnx (largeSize*5)

lnx = l2L . ns

ns n = map asN [1..n]

asN = toN . (`mod` 5)

toN :: Integer -> N
toN 1 = One
toN 2 = Two
toN 3 = Three
toN 4 = Four
toN _ = Five

asN3 = toN3 . (`mod` 5)
toN3 :: Integer -> (N,N,N)
toN3 1 = (One,Two,Three)
toN3 2 = (Two,Three,Four)
toN3 3 = (Three,Four,Five)
toN3 4 = (Four,Five,One)
toN3 _ = (Four,Five,Two)

t33T =("Tuple of Tuple",t33)
t33 = asN33 4

asN33 :: Integer -> ((N, N, N), (N, N, N), (N, N, N))
asN33 n = (asN3 n,asN3 (n+1),asN3 (n+2))

treeNLarge :: Tree N
treeNLarge = mkTree asN largeSize

treeNNNLarge :: Tree (N,N,N)
treeNNNLarge = mkTree asN3 largeSize

treeN33Large :: Tree ((N,N,N),(N,N,N),(N,N,N))
treeN33Large = mkTree asN33 largeSize

treeVarious = mkTree (const v2) 100

mkTree mk = mkTree_ 1
  where
    mkTree_ p 1 = Leaf $ mk p
    mkTree_ p n = let (d,m) = n `divMod` 2
                  in  Node (mkTree_ p d) (mkTree_ (p+d) (d+m))

tree1 :: Tree String
tree1 = Node (Leaf "a leaf") (Node (Leaf "and") (Leaf "more"))

tree2 :: Tree Word64
tree2 = Node (Leaf 17) (Node (Leaf 23) (Leaf 45))

-- ss = take 5 . toList $ stream1

-- stream1 = Stream True stream1

car1 = Car 2343 1965 True ModelB [18,234] "1234" [SunRoof,CruiseControl] (Engine 1200 3 9000 "Fiat" "Petrol") [Consumption 40 18,Consumption 60 23,Consumption 80 25] [(90,[Acceleration 40 12]),(110,[Acceleration 50 11])] "Fiat" "500"

treeN = mkTree asN3 1

asciiStrT = ("asciiStr", longS $ "To hike, or not to hike? US Federal Reserve chair Janet Yellen faces a tricky decision at today's FOMC meeting. Photograph: Action Press/Rex. Theme park operator Merlin Entertainments suffered a significant drop in visitor numbers to its Alton Towers attraction after a serious rollercoaster accident in June.")

unicodeTextUTF8T = ("unicodeTextUTF8",UTF8Text unicodeText)
unicodeTextUTF16T = ("unicodeTextUTF16",UTF16Text unicodeText)

unicodeTextT = ("unicodeText",unicodeText)
unicodeText = T.pack unicodeStr

unicodeStrT = ("unicodeStr",unicodeStr)

unicodeStr = notLongS uniSS

uniSS = "\x1F600\&\x1F600\&\x1F600\&I promessi sposi è un celebre romanzo storico di Alessandro Manzoni, ritenuto il più famoso e il più letto tra quelli scritti in lingua italiana[1].维护和平正义 开创美好未来——习近平主席在纪念中国人民抗日战争暨世界反法西斯战争胜利70周年大会上重要讲话在国际社会引起热烈反响"

longS =  take 1000000 . concat . repeat

notLongS =  take 1000 . concat . repeat

arr0 = ("[Bool]",map (odd . ord) unicodeStr :: [Bool])

arr1 = ("[Word]",map (fromIntegral . ord) unicodeStr :: [Word])

arr2 = ("ByteString from String",B.pack . map (fromIntegral . ord) $ unicodeStr)
sbs = ("StrictByteString",b2)
lbs = ("LazyByteString",lb2)
shortbs = ("ShortByteString",SBS.toShort b2)

mapT = ("map",mapV)
mapV = M.fromList couples
mapListT = ("mapList",couples)

lN2T = ("List N",lN2)
lN3T = ("Large List N",lN3)
nativeListT = ("Large [N]",nativeList)
nativeList = toList lN3
seqNT = ("Seq N",Seq.fromList . toList $ lN2) -- nativeList)
treeNT = ("treeN",treeN)
treeNLargeT = ("treeNLarge",treeNLarge)
treeNNNLargeT = ("treeNNNLarge",treeNNNLarge)
treeN33LargeT = ("treeN33Large",treeN33Large)
treeVariousT = ("Tree Various",treeVarious)
tuple0T = ("block-tuple",(False,(),(3::Word64,33::Word,(True,(),False))))
tupleT = ("tuple",(Two,One,(Five,Three,(Three,(),Two))))
tupleBools = ("tupleBools",(False,(True,False),((True,False,True),(True,False,True))))
oneT   = ("One",One)
tupleWords = ("tupleWord",(18::Word,623723::Word,(8888::Word,823::Word)))
word8T   = ("Word8",34::Word8)
word64T   = ("Word64",34723823923::Word64)
carT = ("car",car1)
wordsT = ("words",wordsV)
wordsV = (18::Word,33::Word8,1230::Word16,9990::Word32,1231232::Word64)
words0T = ("words0",words0V)
words0V = (0::Word,0::Word8,0::Word16,0::Word32,0::Word64)
intsT = ("ints",(444::Int,123::Int8,-8999::Int16,-123823::Int32,-34723823923::Int64))
floatsT = ("floats",floats)
floatsUnaT = ("floats unaligned",(Three,floats))
floats = (3.43::Float,44.23E+23::Double,0.1::Double)
int8T   = ("Int8",-34::Int8)
int64T   = ("Int64",-34723823923::Int64)
integerT   = ("Integer",-3472382392399239230123123::Integer)
charT = ("Char",'a')
unicharT = ("Unicode char", '世')
v1T = ("V1",v1)
v1 = V1 (Just False)
v2T = ("V2",v2)
--v2 = V2 True (Right Nothing) (One,Two,Three)
v2 = V2 True (Right Nothing)
vfT = ("v floats",VF 3.43 44.23E+23 0.1)
vwT = ("v words",vw)
vw = VW 18 33 1230 9990 1231232
-- vw = VW 0 0 0 0 0
viT = ("v ints",VI 444 123 (-8999) (-123823) (-34723823923))
viiT = ("v integers",VII 444 8888 (-34723823923))

-- Copied from binary-typed-0.3/benchmark/Criterion.hs
-- | Data with a normal form.
data NF = forall a. NFData a => NF a

-- | Evaluate 'NF' data to normal form.
force' :: NF -> ()
force' (NF x) = x `deepseq` ()

forceCafs :: IO ()
forceCafs = mapM_ (evaluate . force') cafs

-- | List of all data that should be fully evaluated before the benchmark is
--   run.
cafs :: [NF]
cafs = [
         NF carT
       , NF charT
       , NF unicharT
       , NF wordsT
       , NF words0T
       , NF intsT
       , NF floatT
       , NF doubleT
       , NF floatsT
       , NF floatsUnaT
       , NF tupleT
       , NF tuple0T
       , NF treeNLargeT
       , NF treeNNNLargeT
       , NF treeN33LargeT
       , NF treeNT
       , NF lN2T
       , NF lN3T
       , NF mapT
       , NF mapListT
       , NF nativeListT
       , NF seqNT
       , NF arr1
       , NF arr0
       , NF longS
       , NF unicodeStr
       , NF asciiStrT
       , NF unicodeStrT
       , NF unicodeTextT
       --, NF unicodeTextUTF8T
       --, NF unicodeTextUTF16T
       , NF couples
       , NF v1T
       , NF v2T
       , NF vfT
       , NF vwT
       , NF viT
       , NF viiT
       , NF treeVariousT
       , NF sbs
       , NF lbs
       , NF shortbs
      ]
