116 lines
3.6 KiB
Haskell
116 lines
3.6 KiB
Haskell
{-
|
||
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
|