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

-- | Create and sanatize a python identifier.
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 ()

-- Make a DottedName out of a string like "foo.bar" for use in imports.
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) ()

-- | 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 = 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) ()

-- | Make an attribute access, i.e. self.<string>.
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

      -- 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 = 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
      -- Don't spam with this default arg unless it is really necessary.
      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 ()