{-
 - Copyright 2014 Tycho Andersen
 -
 - Licensed under the Apache License, Version 2.0 (the "License");
 - you may not use this file except in compliance with the License.
 - You may obtain a copy of the License at
 -
 -   http://www.apache.org/licenses/LICENSE-2.0
 -
 - Unless required by applicable law or agreed to in writing, software
 - distributed under the License is distributed on an "AS IS" BASIS,
 - WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 - See the License for the specific language governing permissions and
 - limitations under the License.
 -}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
module Data.XCB.Python.PyHelpers (
  mkRelImport,
  mkAssign,
  mkCall,
  mkEnum,
  mkName,
  mkDot,
  mkAttr,
  mkIncr,
  mkClass,
  mkEmptyClass,
  mkXClass,
  mkStr,
  mkUnpackFrom,
  mkDict,
  mkDictUpdate,
  mkMethod,
  mkReturn,
  mkIf,
  notImplemented
  ) where

import Data.List.Split

import Data.XCB.Python.AST (Expr(..), Op(..), Statement(..), Suite, Ident, PseudoExpr, getExpr)

-- | Make an Expr out of a string like "foo.bar" describing the name.
mkName :: String -> Expr
mkName :: String -> Expr
mkName String
s =
  let strings :: [String]
strings = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"." String
s
  in (Expr -> String -> Expr) -> Expr -> [String] -> Expr
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Expr -> String -> Expr
forall a. PseudoExpr a => a -> String -> Expr
mkDot (String -> Expr
Var (String -> Expr) -> String -> Expr
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. HasCallStack => [a] -> a
head [String]
strings) ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
tail [String]
strings)

mkDot :: PseudoExpr a => a -> String -> Expr
mkDot :: forall a. PseudoExpr a => a -> String -> Expr
mkDot a
e1 String
attr = Expr -> String -> Expr
Dot (a -> Expr
forall a. PseudoExpr a => a -> Expr
getExpr a
e1) String
attr

-- | Make an attribute access, i.e. self.<string>.
mkAttr :: String -> Expr
mkAttr :: String -> Expr
mkAttr String
s = String -> Expr
mkName (String
"self." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s)

mkRelImport :: String -> Statement
mkRelImport :: String -> Statement
mkRelImport String
name = String -> String -> Statement
FromImport String
"." String
name

mkAssign :: PseudoExpr a => a -> Expr -> Statement
mkAssign :: forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign a
name Expr
expr = Expr -> Expr -> Statement
Assign (a -> Expr
forall a. PseudoExpr a => a -> Expr
getExpr a
name) Expr
expr

mkIncr :: String -> Expr -> Statement
mkIncr :: String -> Expr -> Statement
mkIncr String
name Expr
expr = Expr -> Op -> Expr -> Statement
AugmentedAssign (String -> Expr
mkName String
name) Op
Plus Expr
expr

mkCall :: PseudoExpr a => a -> [Expr] -> Expr
mkCall :: forall a. PseudoExpr a => a -> [Expr] -> Expr
mkCall a
name [Expr]
args = Expr -> [Expr] -> Expr
Call (a -> Expr
forall a. PseudoExpr a => a -> Expr
getExpr a
name) [Expr]
args

mkEnum :: String -> [(String, Expr)] -> Statement
mkEnum :: String -> [(String, Expr)] -> Statement
mkEnum String
cname [(String, Expr)]
values =
  let body :: [Statement]
body = ((String, Expr) -> Statement) -> [(String, Expr)] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> Expr -> Statement) -> (String, Expr) -> Statement
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign) [(String, Expr)]
values
  in String -> [String] -> [Statement] -> Statement
Class String
cname [] [Statement]
body

mkXClass :: String -> String -> Bool -> Suite -> Suite -> Statement
mkXClass :: String -> String -> Bool -> [Statement] -> [Statement] -> Statement
mkXClass String
clazz String
superclazz Bool
False [] [] = String -> String -> Statement
mkEmptyClass String
clazz String
superclazz
mkXClass String
clazz String
superclazz Bool
xge [Statement]
constructor [Statement]
methods =
  let args :: [String]
args = [ String
"self", String
"unpacker" ]
      super :: Expr
super = String -> [Expr] -> Expr
forall a. PseudoExpr a => a -> [Expr] -> Expr
mkCall (String
superclazz String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".__init__") ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
mkName [String]
args
      body :: [Statement]
body = Statement
eventToUnpacker Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: (Expr -> Statement
StmtExpr Expr
super) Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
constructor
      xgeexp :: Statement
xgeexp = String -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign String
"xge" (if Bool
xge then (String -> Expr
mkName String
"True") else (String -> Expr
mkName String
"False"))
      initMethod :: Statement
initMethod = String -> [String] -> [Statement] -> Statement
Fun String
"__init__" [String]
args [Statement]
body
  in String -> String -> [Statement] -> Statement
mkClass String
clazz String
superclazz ([Statement] -> Statement) -> [Statement] -> Statement
forall a b. (a -> b) -> a -> b
$ Statement
xgeexp Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: Statement
initMethod Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
methods

    where

      -- In some cases (e.g. when creating ClientMessageEvents), our events are
      -- passed directly to __init__. Since we don't keep track of the
      -- underlying buffers after the event is created, we have to re-pack
      -- things so they can be unpacked again.
      eventToUnpacker :: Statement
      eventToUnpacker :: Statement
eventToUnpacker = let newUnpacker :: Statement
newUnpacker = String -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign String
"unpacker" (String -> [Expr] -> Expr
forall a. PseudoExpr a => a -> [Expr] -> Expr
mkCall String
"xcffib.MemoryUnpacker"
                                                              [String -> [Expr] -> Expr
forall a. PseudoExpr a => a -> [Expr] -> Expr
mkCall String
"unpacker.pack" []])
                            cond :: Expr
cond = String -> [Expr] -> Expr
forall a. PseudoExpr a => a -> [Expr] -> 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 [Statement
Pass]

mkClass :: String -> String -> Suite -> Statement
mkClass :: String -> String -> [Statement] -> Statement
mkClass String
clazz String
superclazz [Statement]
body = String -> [String] -> [Statement] -> Statement
Class String
clazz [String
superclazz] [Statement]
body

mkStr :: String -> Expr
mkStr :: String -> Expr
mkStr String
s = [String] -> Expr
Strings [String
"\"", String
s, String
"\""]

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
Tuple ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (String -> Expr) -> [String] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map String -> Expr
mkAttr [String]
names
      -- Don't spam with this default arg unless it is really necessary.
      unpackF :: Expr
unpackF = a -> String -> Expr
forall a. PseudoExpr a => a -> String -> Expr
mkDot a
unpacker String
"unpack"
      rhs :: Expr
rhs = Expr -> [Expr] -> Expr
forall a. PseudoExpr a => a -> [Expr] -> Expr
mkCall Expr
unpackF [String -> Expr
mkStr String
packs]
      stmt :: Statement
stmt = if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
names Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Expr -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign Expr
lhs Expr
rhs else Expr -> Statement
StmtExpr Expr
rhs
  in if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
packs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [Statement
stmt] else []

mkDict :: String -> Statement
mkDict :: String -> Statement
mkDict String
name = String -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign String
name Expr
EmptyDict

mkDictUpdate :: String -> Int -> String -> Statement
mkDictUpdate :: String -> Int -> String -> Statement
mkDictUpdate String
dict Int
key String
value =
  Expr -> Expr -> Statement
forall a. PseudoExpr a => a -> Expr -> Statement
mkAssign (Expr -> Expr -> Expr
Subscript (String -> Expr
mkName String
dict) (Int -> Expr
Int Int
key)) (String -> Expr
mkName String
value)

mkMethod :: String -> [Ident] -> Suite -> Statement
mkMethod :: String -> [String] -> [Statement] -> Statement
mkMethod String
name [String]
args [Statement]
body = String -> [String] -> [Statement] -> Statement
Fun String
name [String]
args [Statement]
body

mkReturn :: Expr -> Statement
mkReturn :: Expr -> Statement
mkReturn = Maybe Expr -> Statement
Return (Maybe Expr -> Statement)
-> (Expr -> Maybe Expr) -> Expr -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Maybe Expr
forall a. a -> Maybe a
Just

mkIf :: Expr -> Suite -> Statement
mkIf :: Expr -> [Statement] -> Statement
mkIf Expr
e [Statement]
s = Expr -> [Statement] -> [Statement] -> Statement
Conditional Expr
e [Statement]
s []

notImplemented :: Statement
notImplemented :: Statement
notImplemented = String -> Statement
Raise String
"xcffib.XcffibNotImplemented"