summaryrefslogtreecommitdiff
path: root/testsuite/tests/perf/compiler/T15630.hs
blob: 2d666758fc7b12ea2fd1f831873a7b1f123c6de0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module T15630 where

data IValue = IDefault
            | IInt Int
            | IBlob String

(?) :: Applicative m => (IValue -> m a) -> IValue -> m (Maybe a)
(?) _ IDefault = pure Nothing
(?) p x = Just <$> p x

getInt :: IValue -> Either () Int
getInt (IInt i) = Right i
getInt v = Left ()

getString :: IValue -> Either () String
getString (IBlob b) = Right $ b
getString v = Left ()

(<+>) :: Applicative m => (m (a -> b), [IValue]) -> (IValue -> m a) -> (m b, [IValue])
(<+>) (f, (v:vs)) p = (f <*> (p v), vs)

data TestStructure = TestStructure
    { _param1 :: Int
    , _param2 :: Maybe String
    , _param3 :: Maybe Int
    , _param4 :: Maybe String
    , _param5 :: Maybe Int
    , _param6 :: Maybe Int
    , _param7 :: Maybe String
    , _param8 :: Maybe String
    , _param9 :: Maybe Int
    , _param10 :: Maybe Int
    , _param11 :: Maybe String
    , _param12 :: Maybe String
    , _param13 :: Maybe Int
    , _param14 :: Maybe Int
    , _param15 :: Maybe String
    }

getMenuItem :: [IValue] -> Either () TestStructure
getMenuItem vs = fst $ (pure TestStructure, vs)
             <+> getInt
             <+> (getString ?)
             <+> (getInt ?)
             <+> (getString ?)
             <+> (getInt ?)
             <+> (getInt ?)
             <+> (getString ?)
             <+> (getString ?)
             <+> (getInt ?)
             <+> (getInt ?)
             <+> (getString ?)
             <+> (getString ?)
             <+> (getInt ?)
             <+> (getInt ?)
             <+> (getString ?)