{-
 - 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 (
  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 = Expr () -> Expr ()
forall a. a -> a
id

-- | Create and sanatize a python identifier.
ident :: String -> Ident ()
ident :: String -> Ident ()
ident String
s | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
_reserved = String -> () -> Ident ()
forall annot. String -> annot -> Ident annot
Ident (String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) ()
ident String
s | String -> Bool
isInt String
s = String -> () -> Ident ()
forall annot. String -> annot -> Ident annot
Ident (String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s) ()
  where
    isInt :: String -> Bool
isInt String
str = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ ((String -> Maybe Int
maybeRead String
str) :: Maybe Int)
    maybeRead :: String -> Maybe Int
maybeRead = ((Int, String) -> Int) -> Maybe (Int, String) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, String) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, String) -> Maybe Int)
-> (String -> Maybe (Int, String)) -> String -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, String)] -> Maybe (Int, String)
forall a. [a] -> Maybe a
listToMaybe ([(Int, String)] -> Maybe (Int, String))
-> (String -> [(Int, String)]) -> String -> Maybe (Int, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(Int, String)]
forall a. Read a => ReadS a
reads
ident String
s = String -> () -> Ident ()
forall annot. String -> annot -> Ident annot
Ident String
s ()

-- Make a DottedName out of a string like "foo.bar" for use in imports.
mkDottedName :: String -> DottedName ()
mkDottedName :: String -> DottedName ()
mkDottedName = (String -> Ident ()) -> [String] -> DottedName ()
forall a b. (a -> b) -> [a] -> [b]
map String -> Ident ()
ident ([String] -> DottedName ())
-> (String -> [String]) -> String -> DottedName ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"."

mkVar :: String -> Expr ()
mkVar :: String -> Expr ()
mkVar String
name = Ident () -> () -> Expr ()
forall annot. Ident annot -> annot -> Expr annot
Var (String -> Ident ()
ident String
name) ()

-- | 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 (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 ()
mkVar (String -> Expr ()) -> String -> Expr ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. [a] -> a
head [String]
strings) ([String] -> [String]
forall a. [a] -> [a]
tail [String]
strings)

mkDot :: PseudoExpr a => a -> String -> Expr ()
mkDot :: a -> String -> Expr ()
mkDot a
e1 String
attr = Expr () -> Ident () -> () -> Expr ()
forall annot. Expr annot -> Ident annot -> annot -> Expr annot
Dot (a -> Expr ()
forall a. PseudoExpr a => a -> Expr ()
getExpr a
e1) (String -> Ident ()
ident 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)

mkImport :: String -> Statement ()
mkImport :: String -> Statement ()
mkImport String
name = [ImportItem ()] -> () -> Statement ()
forall annot. [ImportItem annot] -> annot -> Statement annot
Import [DottedName () -> Maybe (Ident ()) -> () -> ImportItem ()
forall annot.
DottedName annot
-> Maybe (Ident annot) -> annot -> ImportItem annot
ImportItem (String -> DottedName ()
mkDottedName String
name) Maybe (Ident ())
forall a. Maybe a
Nothing ()] ()

mkRelImport :: String -> Statement ()
mkRelImport :: String -> Statement ()
mkRelImport String
name = ImportRelative () -> FromItems () -> () -> Statement ()
forall annot.
ImportRelative annot -> FromItems annot -> annot -> Statement annot
FromImport (Int -> Maybe (DottedName ()) -> () -> ImportRelative ()
forall annot.
Int -> Maybe (DottedName annot) -> annot -> ImportRelative annot
ImportRelative Int
1 Maybe (DottedName ())
forall a. Maybe a
Nothing ()) ([FromItem ()] -> () -> FromItems ()
forall annot. [FromItem annot] -> annot -> FromItems annot
FromItems [Ident () -> Maybe (Ident ()) -> () -> FromItem ()
forall annot.
Ident annot -> Maybe (Ident annot) -> annot -> FromItem annot
FromItem (String -> Ident ()
ident String
name) Maybe (Ident ())
forall a. Maybe a
Nothing ()] ()) ()

mkInt :: Int -> Expr ()
mkInt :: Int -> Expr ()
mkInt Int
i = Integer -> String -> () -> Expr ()
forall annot. Integer -> String -> annot -> Expr annot
Int (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i) (Int -> String
forall a. Show a => a -> String
show Int
i) ()

mkAssign :: PseudoExpr a => a -> Expr () -> Statement ()
mkAssign :: a -> Expr () -> Statement ()
mkAssign a
name Expr ()
expr = [Expr ()] -> Expr () -> () -> Statement ()
forall annot.
[Expr annot] -> Expr annot -> annot -> Statement annot
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 () -> AssignOp () -> Expr () -> () -> Statement ()
forall annot.
Expr annot
-> AssignOp annot -> Expr annot -> annot -> Statement annot
AugmentedAssign (String -> Expr ()
mkName String
name) (() -> AssignOp ()
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 = Expr () -> () -> Argument ()
forall annot. Expr annot -> annot -> Argument annot
ArgExpr Expr ()
p ()
instance PseudoArgument (Argument ()) where
  getArgument :: Argument () -> Argument ()
getArgument = Argument () -> Argument ()
forall a. a -> a
id

mkCall :: (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall :: a -> [b] -> Expr ()
mkCall a
name [b]
args = Expr () -> [Argument ()] -> () -> Expr ()
forall annot. Expr annot -> [Argument annot] -> annot -> Expr annot
Call (a -> Expr ()
forall a. PseudoExpr a => a -> Expr ()
getExpr a
name) ((b -> Argument ()) -> [b] -> [Argument ()]
forall a b. (a -> b) -> [a] -> [b]
map b -> Argument ()
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 = ((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 Ident () -> [Argument ()] -> [Statement ()] -> () -> Statement ()
forall annot.
Ident annot
-> [Argument annot] -> Suite annot -> annot -> Statement annot
Class (String -> () -> Ident ()
forall annot. String -> annot -> Ident annot
Ident String
cname ()) [] [Statement ()]
body ()

mkParams :: [String] -> [Parameter ()]
mkParams :: [String] -> [Parameter ()]
mkParams = (String -> Parameter ()) -> [String] -> [Parameter ()]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> Ident ()
-> Maybe (Expr ()) -> Maybe (Expr ()) -> () -> Parameter ()
forall annot.
Ident annot
-> Maybe (Expr annot)
-> Maybe (Expr annot)
-> annot
-> Parameter annot
Param (String -> Ident ()
ident String
x) Maybe (Expr ())
forall a. Maybe a
Nothing Maybe (Expr ())
forall a. Maybe a
Nothing ())

mkArg :: String -> Argument ()
mkArg :: String -> Argument ()
mkArg String
n = Expr () -> () -> Argument ()
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 = String -> [Expr ()] -> Expr ()
forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> 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 ()
forall annot. Expr annot -> annot -> Statement annot
StmtExpr Expr ()
super ()) Statement () -> [Statement ()] -> [Statement ()]
forall a. a -> [a] -> [a]
: [Statement ()]
constructor
      initParams :: [Parameter ()]
initParams = [String] -> [Parameter ()]
mkParams [String]
args
      initMethod :: Statement ()
initMethod = Ident ()
-> [Parameter ()]
-> Maybe (Expr ())
-> [Statement ()]
-> ()
-> Statement ()
forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun (String -> Ident ()
ident String
"__init__") [Parameter ()]
initParams Maybe (Expr ())
forall a. Maybe a
Nothing [Statement ()]
body ()
  in String -> String -> [Statement ()] -> Statement ()
mkClass String
clazz String
superclazz ([Statement ()] -> Statement ()) -> [Statement ()] -> Statement ()
forall a b. (a -> b) -> a -> b
$ 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 b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall String
"xcffib.MemoryUnpacker"
                                                              [String -> [Argument ()] -> Expr ()
forall a b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall String
"unpacker.pack" [Argument ()]
noArgs])
                            cond :: Expr ()
cond = String -> [Expr ()] -> Expr ()
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 [() -> Statement ()
forall annot. annot -> Statement annot
Pass ()]

mkClass :: String -> String -> Suite () -> Statement ()
mkClass :: String -> String -> [Statement ()] -> Statement ()
mkClass String
clazz String
superclazz [Statement ()]
body = Ident () -> [Argument ()] -> [Statement ()] -> () -> Statement ()
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 = [String] -> () -> Expr ()
forall annot. [String] -> annot -> Expr annot
Strings [String
"\"", String
s, String
"\""] ()

mkTuple :: [Expr ()] -> Expr ()
mkTuple :: [Expr ()] -> Expr ()
mkTuple = ([Expr ()] -> () -> Expr ()) -> () -> [Expr ()] -> Expr ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Expr ()] -> () -> Expr ()
forall annot. [Expr annot] -> annot -> Expr annot
Tuple ()

mkUnpackFrom :: PseudoExpr a => a -> [String] -> String -> Suite ()
mkUnpackFrom :: a -> [String] -> String -> [Statement ()]
mkUnpackFrom a
unpacker [String]
names String
packs =
  let lhs :: Expr ()
lhs = [Expr ()] -> Expr ()
mkTuple ([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 b. (PseudoExpr a, PseudoArgument b) => a -> [b] -> Expr ()
mkCall Expr ()
unpackF [String -> Expr ()
mkStr String
packs]
      stmt :: Statement ()
stmt = if [String] -> 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 ()
forall annot. Expr annot -> annot -> Statement annot
StmtExpr Expr ()
rhs ()
  in if String -> 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 ([DictKeyDatumList ()] -> () -> Expr ()
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 =
  Expr () -> Expr () -> Statement ()
forall a. PseudoExpr a => a -> Expr () -> Statement ()
mkAssign (Expr () -> Expr () -> () -> Expr ()
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 = Ident ()
-> [Parameter ()]
-> Maybe (Expr ())
-> [Statement ()]
-> ()
-> Statement ()
forall annot.
Ident annot
-> [Parameter annot]
-> Maybe (Expr annot)
-> Suite annot
-> annot
-> Statement annot
Fun (String -> Ident ()
ident String
name) [Parameter ()]
args Maybe (Expr ())
forall a. Maybe a
Nothing [Statement ()]
body ()

mkReturn :: Expr () -> Statement ()
mkReturn :: Expr () -> Statement ()
mkReturn = (Maybe (Expr ()) -> () -> Statement ())
-> () -> Maybe (Expr ()) -> Statement ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Maybe (Expr ()) -> () -> Statement ()
forall annot. Maybe (Expr annot) -> annot -> Statement annot
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

pyTruth :: Bool -> Expr ()
pyTruth :: Bool -> Expr ()
pyTruth = (Bool -> () -> Expr ()) -> () -> Bool -> Expr ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bool -> () -> Expr ()
forall annot. Bool -> annot -> Expr annot
Bool ()

pyNone :: Expr ()
pyNone :: Expr ()
pyNone = () -> Expr ()
forall annot. annot -> Expr annot
None ()

mkIf :: Expr () -> Suite () -> Statement ()
mkIf :: Expr () -> [Statement ()] -> Statement ()
mkIf Expr ()
e [Statement ()]
s = [(Expr (), [Statement ()])] -> [Statement ()] -> () -> Statement ()
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 = Op () -> Expr () -> Expr () -> () -> Expr ()
forall annot.
Op annot -> Expr annot -> Expr annot -> annot -> Expr annot
BinaryOp (() -> Op ()
forall annot. annot -> Op annot
Multiply ()) (String -> Expr ()
mkStr String
s) Expr ()
i ()