{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Data.XCB.Python.PyHelpers (
mkImport,
mkRelImport,
mkInt,
mkAssign,
mkCall,
noArgs,
mkArg,
mkEnum,
mkName,
mkDot,
mkAttr,
mkIncr,
mkClass,
mkEmptyClass,
mkXClass,
mkStr,
mkUnpackFrom,
mkDict,
mkDictUpdate,
mkMethod,
mkReturn,
pyTruth,
mkParams,
ident,
pyNone,
mkIf,
repeatStr
) where
import Data.List.Split
import Data.Maybe
import Language.Python.Common
_reserved :: [String]
_reserved :: [String]
_reserved = [ String
"None"
, String
"def"
, String
"class"
, String
"and"
, String
"or"
]
class PseudoExpr a where
getExpr :: a -> Expr ()
instance PseudoExpr String where
getExpr :: String -> Expr ()
getExpr String
s = String -> Expr ()
mkName String
s
instance PseudoExpr (Expr ()) where
getExpr :: Expr () -> Expr ()
getExpr = forall a. a -> a
id
ident :: String -> Ident ()
ident :: String -> Ident ()
ident String
s | String
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
_reserved = forall annot. String -> annot -> Ident annot
Ident (String
"_" forall a. [a] -> [a] -> [a]
++ String
s) ()
ident String
s | String -> Bool
isInt String
s = forall annot. String -> annot -> Ident annot
Ident (String
"_" forall a. [a] -> [a] -> [a]
++ String
s) ()
where
isInt :: String -> Bool
isInt String
str = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ ((String -> Maybe Int
maybeRead String
str) :: Maybe Int)
maybeRead :: String -> Maybe Int
maybeRead = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => ReadS a
reads
ident String
s = forall annot. String -> annot -> Ident annot
Ident String
s ()
mkDottedName :: String -> DottedName ()
mkDottedName :: String -> DottedName ()
mkDottedName = forall a b. (a -> b) -> [a] -> [b]
map String -> Ident ()
ident forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"."
mkVar :: String -> Expr ()
mkVar :: String -> Expr ()
mkVar String
name = forall annot. Ident annot -> annot -> Expr annot
Var (String -> Ident ()
ident String
name) ()
mkName :: String -> Expr ()
mkName :: String -> Expr ()
mkName String
s =
let strings :: [String]
strings = forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s
in forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall a. PseudoExpr a => a -> String -> Expr ()
mkDot (String -> Expr ()
mkVar forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [String]
strings) (forall a. [a] -> [a]
tail [String]
strings)
mkDot :: PseudoExpr a => a -> String -> Expr ()
mkDot :: forall a. PseudoExpr a => a -> String -> Expr ()
mkDot a
e1 String
attr = forall annot. Expr annot -> Ident annot -> annot -> Expr annot
Dot (forall a. PseudoExpr a => a -> Expr ()
getExpr a
e1) (String -> Ident ()
ident String
attr) ()
mkAttr :: String -> Expr ()
mkAttr :: String -> Expr ()
mkAttr String
s = String -> Expr ()
mkName (String
"self." forall a. [a] -> [a] -> [a]
++ String
s)
mkImport :: String -> Statement ()
mkImport :: String -> Statement ()
mkImport String
name = forall annot. [ImportItem annot] -> annot -> Statement annot
Import [forall annot.
DottedName annot
-> Maybe (Ident annot) -> annot -> ImportItem annot
ImportItem (String -> DottedName ()
mkDottedName String
name) forall a. Maybe a
Nothing ()] ()
mkRelImport :: String -> Statement ()
mkRelImport :: String -> Statement ()
mkRelImport String
name = forall annot.
ImportRelative annot -> FromItems annot -> annot -> Statement annot
FromImport (forall annot.
Int -> Maybe (DottedName annot) -> annot -> ImportRelative annot
ImportRelative Int
1 forall a. Maybe a
Nothing ()) (forall annot. [FromItem annot] -> annot -> FromItems annot
FromItems [forall annot.
Ident annot -> Maybe (Ident annot) -> annot -> FromItem annot
FromItem (String -> Ident ()
ident String
name) forall a. Maybe a
Nothing ()] ()) ()
mkInt :: Int -> Expr ()
mkInt :: Int -> Expr ()
mkInt Int
i = forall annot. Integer -> String -> annot -> Expr annot
Int (forall a. Integral a => a -> Integer
toInteger Int
i) (forall a. Show a => a -> String
show Int
i) ()
mkAssign :: PseudoExpr a => a -> Expr () -> Statement ()
mkAssign :: forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign a
name Expr ()
expr = forall annot.
[Expr annot] -> Expr annot -> annot -> Statement annot
Assign [forall a. PseudoExpr a => a -> Expr ()
getExpr a
name] Expr ()
expr ()
mkIncr :: String -> Expr () -> Statement ()
mkIncr :: String -> Expr () -> Statement ()
mkIncr String
name Expr ()
expr = forall annot.
Expr annot
-> AssignOp annot -> Expr annot -> annot -> Statement annot
AugmentedAssign (String -> Expr ()
mkName String
name) (forall annot. annot -> AssignOp annot
PlusAssign ()) Expr ()
expr ()
class PseudoArgument a where
getArgument :: a -> Argument ()
instance PseudoArgument (Expr ()) where
getArgument :: Expr () -> Argument ()
getArgument Expr ()
p = forall annot. Expr annot -> annot -> Argument annot
ArgExpr Expr ()
p ()
instance PseudoArgument (Argument ()) where
getArgument :: Argument () -> Argument ()
getArgument = forall a. a -> a
id
mkCall :: (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall :: forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall a
name [b]
args = forall annot. Expr annot -> [Argument annot] -> annot -> Expr annot
Call (forall a. PseudoExpr a => a -> Expr ()
getExpr a
name) (forall a b. (a -> b) -> [a] -> [b]
map forall a. PseudoArgument a => a -> Argument ()
getArgument [b]
args) ()
noArgs :: [Argument ()]
noArgs :: [Argument ()]
noArgs = []
mkEnum :: String -> [(String, Expr ())] -> Statement ()
mkEnum :: String -> [(String, Expr ())] -> Statement ()
mkEnum String
cname [(String, Expr ())]
values =
let body :: [Statement ()]
body = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign) [(String, Expr ())]
values
in forall annot.
Ident annot
-> [Argument annot] -> Suite annot -> annot -> Statement annot
Class (forall annot. String -> annot -> Ident annot
Ident String
cname ()) [] [Statement ()]
body ()
mkParams :: [String] -> [Parameter ()]
mkParams :: [String] -> [Parameter ()]
mkParams = forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param (String -> Ident ()
ident String
x) forall a. Maybe a
Nothing forall a. Maybe a
Nothing ())
mkArg :: String -> Argument ()
mkArg :: String -> Argument ()
mkArg String
n = forall annot. Expr annot -> annot -> Argument annot
ArgExpr (String -> Expr ()
mkName String
n) ()
mkXClass :: String -> String -> Suite () -> Suite () -> Statement ()
mkXClass :: String
-> String -> [Statement ()] -> [Statement ()] -> Statement ()
mkXClass String
clazz String
superclazz [] [] = String -> String -> Statement ()
mkEmptyClass String
clazz String
superclazz
mkXClass String
clazz String
superclazz [Statement ()]
constructor [Statement ()]
methods =
let args :: [String]
args = [ String
"self", String
"unpacker" ]
super :: Expr ()
super = forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall (String
superclazz forall a. [a] -> [a] -> [a]
++ String
".__init__") forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Expr ()
mkName [String]
args
body :: [Statement ()]
body = Statement ()
eventToUnpacker forall a. a -> [a] -> [a]
: (forall annot. Expr annot -> annot -> Statement annot
StmtExpr Expr ()
super ()) forall a. a -> [a] -> [a]
: [Statement ()]
constructor
initParams :: [Parameter ()]
initParams = [String] -> [Parameter ()]
mkParams [String]
args
initMethod :: Statement ()
initMethod = forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun (String -> Ident ()
ident String
"__init__") [Parameter ()]
initParams forall a. Maybe a
Nothing [Statement ()]
body ()
in String -> String -> [Statement ()] -> Statement ()
mkClass String
clazz String
superclazz forall a b. (a -> b) -> a -> b
$ Statement ()
initMethod forall a. a -> [a] -> [a]
: [Statement ()]
methods
where
eventToUnpacker :: Statement ()
eventToUnpacker :: Statement ()
eventToUnpacker = let newUnpacker :: Statement ()
newUnpacker = forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign String
"unpacker" (forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall String
"xcffib.MemoryUnpacker"
[forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall String
"unpacker.pack" [Argument ()]
noArgs])
cond :: Expr ()
cond = forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall String
"isinstance" [String -> Expr ()
mkName String
"unpacker", String -> Expr ()
mkName String
"xcffib.Protobj"]
in Expr () -> [Statement ()] -> Statement ()
mkIf Expr ()
cond [Statement ()
newUnpacker]
mkEmptyClass :: String -> String -> Statement ()
mkEmptyClass :: String -> String -> Statement ()
mkEmptyClass String
clazz String
superclazz = String -> String -> [Statement ()] -> Statement ()
mkClass String
clazz String
superclazz [forall annot. annot -> Statement annot
Pass ()]
mkClass :: String -> String -> Suite () -> Statement ()
mkClass :: String -> String -> [Statement ()] -> Statement ()
mkClass String
clazz String
superclazz [Statement ()]
body = forall annot.
Ident annot
-> [Argument annot] -> Suite annot -> annot -> Statement annot
Class (String -> Ident ()
ident String
clazz) [String -> Argument ()
mkArg String
superclazz] [Statement ()]
body ()
mkStr :: String -> Expr ()
mkStr :: String -> Expr ()
mkStr String
s = forall annot. [String] -> annot -> Expr annot
Strings [String
"\"", String
s, String
"\""] ()
mkTuple :: [Expr ()] -> Expr ()
mkTuple :: [Expr ()] -> Expr ()
mkTuple = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall annot. [Expr annot] -> annot -> Expr annot
Tuple ()
mkUnpackFrom :: PseudoExpr a => a -> [String] -> String -> Suite ()
mkUnpackFrom :: forall a. PseudoExpr a => a -> [String] -> String -> [Statement ()]
mkUnpackFrom a
unpacker [String]
names String
packs =
let lhs :: Expr ()
lhs = [Expr ()] -> Expr ()
mkTuple forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map String -> Expr ()
mkAttr [String]
names
unpackF :: Expr ()
unpackF = forall a. PseudoExpr a => a -> String -> Expr ()
mkDot a
unpacker String
"unpack"
rhs :: Expr ()
rhs = forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall Expr ()
unpackF [String -> Expr ()
mkStr String
packs]
stmt :: Statement ()
stmt = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names forall a. Ord a => a -> a -> Bool
> Int
0 then forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign Expr ()
lhs Expr ()
rhs else forall annot. Expr annot -> annot -> Statement annot
StmtExpr Expr ()
rhs ()
in if forall (t :: * -> *) a. Foldable t => t a -> Int
length String
packs forall a. Ord a => a -> a -> Bool
> Int
0 then [Statement ()
stmt] else []
mkDict :: String -> Statement ()
mkDict :: String -> Statement ()
mkDict String
name = forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign String
name (forall annot. [DictKeyDatumList annot] -> annot -> Expr annot
Dictionary [] ())
mkDictUpdate :: String -> Int -> String -> Statement ()
mkDictUpdate :: String -> Int -> String -> Statement ()
mkDictUpdate String
dict Int
key String
value =
forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign (forall annot. Expr annot -> Expr annot -> annot -> Expr annot
Subscript (String -> Expr ()
mkName String
dict) (Int -> Expr ()
mkInt Int
key) ()) (String -> Expr ()
mkName String
value)
mkMethod :: String -> [Parameter ()] -> Suite () -> Statement ()
mkMethod :: String -> [Parameter ()] -> [Statement ()] -> Statement ()
mkMethod String
name [Parameter ()]
args [Statement ()]
body = forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun (String -> Ident ()
ident String
name) [Parameter ()]
args forall a. Maybe a
Nothing [Statement ()]
body ()
mkReturn :: Expr () -> Statement ()
mkReturn :: Expr () -> Statement ()
mkReturn = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall annot. Maybe (Expr annot) -> annot -> Statement annot
Return () forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just
pyTruth :: Bool -> Expr ()
pyTruth :: Bool -> Expr ()
pyTruth = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall annot. Bool -> annot -> Expr annot
Bool ()
pyNone :: Expr ()
pyNone :: Expr ()
pyNone = forall annot. annot -> Expr annot
None ()
mkIf :: Expr () -> Suite () -> Statement ()
mkIf :: Expr () -> [Statement ()] -> Statement ()
mkIf Expr ()
e [Statement ()]
s = forall annot.
[(Expr annot, Suite annot)]
-> Suite annot -> annot -> Statement annot
Conditional [(Expr ()
e, [Statement ()]
s)] [] ()
repeatStr :: String -> Expr () -> Expr ()
repeatStr :: String -> Expr () -> Expr ()
repeatStr String
s Expr ()
i = forall annot.
Op annot -> Expr annot -> Expr annot -> annot -> Expr annot
BinaryOp (forall annot. annot -> Op annot
Multiply ()) (String -> Expr ()
mkStr String
s) Expr ()
i ()