module Language.Lua.Lift (LiftExp(..)) where
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import GHC.Generics
import Language.Lua
class LiftExp a where
liftExp :: a -> Exp
default liftExp :: (GLiftExp (Rep a), Generic a) => a -> Exp
liftExp a = gLiftExp (from a)
instance LiftExp Exp where
liftExp = id
instance LiftExp Bool where
liftExp = Bool
instance LiftExp Int where
liftExp = Number . show
instance LiftExp Double where
liftExp = Number . show
instance LiftExp Integer where
liftExp = Number . show
instance LiftExp [Char] where
liftExp = String
instance LiftExp a => LiftExp [a] where
liftExp = TableConst . map (Field . liftExp)
instance LiftExp PrefixExp where
liftExp = PrefixExp
instance LiftExp LT.Text where
liftExp = String . LT.unpack
instance LiftExp T.Text where
liftExp = String . T.unpack
instance (LiftExp a, LiftExp b) => LiftExp (a, b) where
liftExp (a, b) = TableConst $ map Field [liftExp a, liftExp b]
instance (LiftExp a, LiftExp b, LiftExp c) => LiftExp (a, b, c) where
liftExp (a, b, c) = TableConst $ map Field [liftExp a, liftExp b, liftExp c]
instance (LiftExp a, LiftExp b, LiftExp c, LiftExp d)
=> LiftExp (a, b, c, d) where
liftExp (a, b, c, d) =
TableConst $ map Field [liftExp a, liftExp b, liftExp c, liftExp d]
instance (LiftExp a, LiftExp b, LiftExp c, LiftExp d, LiftExp e)
=> LiftExp (a, b, c, d, e) where
liftExp (a, b, c, d, e) =
TableConst $ map Field [liftExp a, liftExp b, liftExp c, liftExp d, liftExp e]
class GLiftExp a where
gLiftExp :: a x -> Exp
instance LiftExp a => GLiftExp (K1 r a) where
gLiftExp (K1 a) = liftExp a
instance (GLiftExp l, GLiftExp r) => GLiftExp (l :+: r) where
gLiftExp (L1 l) = gLiftExp l
gLiftExp (R1 r) = gLiftExp r
instance (Selector s, GLiftExp l) => GDecodeProduct (M1 S s l) where
gDecodeProduct s@(M1 l) =
case selName s of
"" -> [Field $ gLiftExp l]
sn -> [NamedField sn $ gLiftExp l]
instance (Constructor c, GDecodeProduct f) => GLiftExp (M1 C c f) where
gLiftExp m@(M1 f) =
let xs = gDecodeProduct f
cn = conName m
in if null xs
then TableConst [ NamedField "con" (String cn)]
else TableConst [ NamedField "con" (String cn)
, NamedField "args" $ TableConst xs]
class GDecodeProduct k where
gDecodeProduct :: k x -> [TableField]
instance (Datatype c, GLiftExp f) => GLiftExp (M1 D c f) where
gLiftExp m@(M1 a) =
case gLiftExp a of
TableConst xs ->
TableConst $ NamedField "typ" (String $ datatypeName m) : xs
_ -> error "GLiftExp cannoooot!!!"
instance LiftExp c => GDecodeProduct (K1 i c) where
gDecodeProduct (K1 a) = [Field $ liftExp a]
instance GDecodeProduct U1 where
gDecodeProduct U1 = []
instance (GDecodeProduct a, GDecodeProduct b) => GDecodeProduct (a :*: b) where
gDecodeProduct (a :*: b) = gDecodeProduct a ++ gDecodeProduct b
instance LiftExp a => LiftExp (Maybe a)