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
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
|
{-
Copyright © 2012-2017 John MacFarlane <jgm@berkeley.edu>
2017 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
#if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-}
#endif
{-# OPTIONS_GHC -fno-warn-orphans #-}
{- |
Module : Text.Pandoc.Lua.SharedInstances
Copyright : © 2012–2016 John MacFarlane,
© 2017 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
Stability : alpha
Shared StackValue instances for pandoc and generic types.
-}
module Text.Pandoc.Lua.SharedInstances () where
import Scripting.Lua ( LTYPE(..), StackValue(..), newtable )
import Text.Pandoc.Lua.Util ( addRawInt, addValue, getRawInt, keyValuePairs )
import qualified Data.Map as M
import qualified Text.Pandoc.UTF8 as UTF8
#if MIN_VERSION_base(4,8,0)
instance {-# OVERLAPS #-} StackValue [Char] where
#else
instance StackValue [Char] where
#endif
push lua cs = push lua (UTF8.fromString cs)
peek lua i = fmap UTF8.toString <$> peek lua i
valuetype _ = TSTRING
instance (StackValue a, StackValue b) => StackValue (a, b) where
push lua (a, b) = do
newtable lua
addRawInt lua 1 a
addRawInt lua 2 b
peek lua idx = do
a <- getRawInt lua idx 1
b <- getRawInt lua idx 2
return $ (,) <$> a <*> b
valuetype _ = TTABLE
instance (StackValue a, StackValue b, StackValue c) =>
StackValue (a, b, c)
where
push lua (a, b, c) = do
newtable lua
addRawInt lua 1 a
addRawInt lua 2 b
addRawInt lua 3 c
peek lua idx = do
a <- getRawInt lua idx 1
b <- getRawInt lua idx 2
c <- getRawInt lua idx 3
return $ (,,) <$> a <*> b <*> c
valuetype _ = TTABLE
instance (StackValue a, StackValue b, StackValue c,
StackValue d, StackValue e) =>
StackValue (a, b, c, d, e)
where
push lua (a, b, c, d, e) = do
newtable lua
addRawInt lua 1 a
addRawInt lua 2 b
addRawInt lua 3 c
addRawInt lua 4 d
addRawInt lua 5 e
peek lua idx = do
a <- getRawInt lua idx 1
b <- getRawInt lua idx 2
c <- getRawInt lua idx 3
d <- getRawInt lua idx 4
e <- getRawInt lua idx 5
return $ (,,,,) <$> a <*> b <*> c <*> d <*> e
valuetype _ = TTABLE
instance (Ord a, StackValue a, StackValue b) =>
StackValue (M.Map a b) where
push lua m = do
newtable lua
mapM_ (uncurry $ addValue lua) $ M.toList m
peek lua idx = fmap M.fromList <$> keyValuePairs lua idx
valuetype _ = TTABLE
instance (StackValue a, StackValue b) => StackValue (Either a b) where
push lua = \case
Left x -> push lua x
Right x -> push lua x
peek lua idx = peek lua idx >>= \case
Just left -> return . Just $ Left left
Nothing -> fmap Right <$> peek lua idx
valuetype (Left x) = valuetype x
valuetype (Right x) = valuetype x
|
