1 files changed, 106 insertions, 0 deletions
diff --git a/src/Text/Pandoc/Lua/SharedInstances.hs b/src/Text/Pandoc/Lua/SharedInstances.hs
new file mode 100644
index 000000000..02438b93b
--- /dev/null
+++ b/src/Text/Pandoc/Lua/SharedInstances.hs
@@ -0,0 +1,106 @@
+{-
+Copyright © 2012-2016 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