tdlib-gen 0.2.0 → 0.3.0
raw patch · 6 files changed
+62/−26 lines, 6 files
Files
- CHANGELOG.md +5/−0
- src/Codegen.hs +13/−19
- src/Language/Haskell/Codegen.hs +0/−2
- src/Language/Haskell/Codegen/TH.hs +2/−2
- src/Text/Casing.hs +38/−0
- tdlib-gen.cabal +4/−3
CHANGELOG.md view
@@ -8,3 +8,8 @@ - flatten function defitions - less invasive sanitization++## 0.3.0++- change the casing of generated datatype to camelCase+
src/Codegen.hs view
@@ -2,7 +2,6 @@ import Data.Aeson import Data.Char-import Data.Foldable import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe)@@ -11,12 +10,7 @@ import Language.Haskell.Codegen import Language.TL.AST hiding (ADT (..), Ann, App, Type (..)) import qualified Language.TL.AST as A--upper :: Text -> Text-upper t = T.cons (toUpper $ T.head t) (T.tail t)--lower :: String -> String-lower t = (toLower $ head t) : (tail t)+import Text.Casing type TyMap = Map Text Text @@ -42,7 +36,7 @@ } mkModifier :: FieldMapping -> Modifier-mkModifier m s = fromMaybe s (M.lookup s m)+mkModifier m s = fromMaybe (camelToSnake s) (M.lookup s m) defTyMap :: TyMap defTyMap =@@ -58,7 +52,7 @@ typeConv :: TyMap -> A.Type -> Type typeConv m (A.Type t) = Type $ fromMaybe (upper t) $ M.lookup t m typeConv m (A.TypeApp t ts) = app (typeConv m t) (fmap (typeConv m) ts)-typeConv m A.NatType = Type "Int"+typeConv _ A.NatType = Type "Int" app :: Type -> [Type] -> Type app t = foldl (\acc ty -> App acc ty) t@@ -99,7 +93,7 @@ } countElem :: Eq a => a -> [a] -> Int-countElem a [] = error "Not in list"+countElem _ [] = error "Not in list" countElem a (x : xs) = if x == a then 0@@ -109,18 +103,18 @@ sanitize' "type" = ("type_", M.fromList [("type_", "type")]) sanitize' "data" = ("data_", M.fromList [("data_", "data")]) sanitize' "pattern" = ("pattern_", M.fromList [("pattern_", "pattern")])-sanitize' t = (t, mempty)+sanitize' t = (snakeToCamel t, mempty) sanitizeArg :: Int -> Text -> (Text, FieldMapping) sanitizeArg 0 t = sanitize' t sanitizeArg i t =- let n = t <> "_" <> pack (show i)+ let n = (snakeToCamel t) <> "_" <> pack (show i) in (n, M.fromList [(unpack n, unpack t)]) -type State = (Map Text [Type], FieldMapping)+type SanitizerState = (Map Text [Type], FieldMapping) -sanitizeField :: State -> Field -> (State, Field)-sanitizeField (tyMap, fieldMap) f@Field {..} =+sanitizeField :: SanitizerState -> Field -> (SanitizerState, Field)+sanitizeField (tyMap, fieldMap) Field {..} = case M.lookup name tyMap of Nothing -> let (name', dfm) = sanitizeArg 0 name@@ -137,12 +131,12 @@ tyMap' = M.insert name (l <> [ty]) tyMap in ((tyMap', fieldMap <> dfm), Field name' ann ty) -sanitizeField' :: Field -> (State, [Field]) -> (State, [Field])+sanitizeField' :: Field -> (SanitizerState, [Field]) -> (SanitizerState, [Field]) sanitizeField' f (s, fs) = let (s', f') = sanitizeField s f in (s', f' : fs) -sanitizeConstr :: State -> Constr -> (State, Constr)+sanitizeConstr :: SanitizerState -> Constr -> (SanitizerState, Constr) sanitizeConstr s Constr {..} = let (s', fields') = foldr sanitizeField' (s, []) fields in ( s',@@ -152,13 +146,13 @@ } ) -sanitizeConstr' :: Constr -> (State, [Constr]) -> (State, [Constr])+sanitizeConstr' :: Constr -> (SanitizerState, [Constr]) -> (SanitizerState, [Constr]) sanitizeConstr' c (s, cs) = let (s', c') = sanitizeConstr s c in (s', c' : cs) sanitizeADT :: ADT -> (ADT, FieldMapping)-sanitizeADT adt@ADT {..} =+sanitizeADT ADT {..} = let ((_, fm), constr') = foldr sanitizeConstr' mempty constr in ( ADT { constr = constr',
src/Language/Haskell/Codegen.hs view
@@ -6,7 +6,6 @@ import Control.Lens import Data.Generics.Labels () import Data.List-import Data.Map.Strict (Map) import Data.String import Data.Text (Text) import qualified Data.Text as T@@ -149,7 +148,6 @@ flattenSig FunDef {..} = let n = unsafeTextWithoutNewlines name doc = prettyDoc ann- c = unsafeTextWithoutNewlines (constr ^. #name) sig = pretty $ formArr (fmap getAnn (fields constr)) (res, Nothing) in vsep [ doc <> n <+> "::",
src/Language/Haskell/Codegen/TH.hs view
@@ -25,8 +25,8 @@ preProcess :: FilePath -> IO ([ADT], [ADT]) preProcess fp = do- f <- T.readFile fp- let mprog = runParser program "td_api.tl" f+ file <- T.readFile fp+ let mprog = runParser program "td_api.tl" file case mprog of Left _ -> error "parse failed!" Right prog -> do
+ src/Text/Casing.hs view
@@ -0,0 +1,38 @@+module Text.Casing where++import Data.Char+import Data.List (intercalate)+import Data.Text (Text, split)+import qualified Data.Text as T++upper :: Text -> Text+upper t = T.cons (toUpper $ T.head t) (T.tail t)++upper' :: String -> String+upper' (x : xs) = toUpper x : xs++lower :: String -> String+lower t = (toLower $ head t) : (tail t)++lower' :: Text -> Text+lower' t = T.cons (toLower $ T.head t) (T.tail t)++splitOn' :: (Char -> Bool) -> String -> [String]+splitOn' p t = go t+ where+ go1 s "" = (reverse s, "")+ go1 "" (x : xs) = go1 [x] xs+ go1 s s'@(x : xs) = if not (p x) then go1 (x : s) xs else (reverse s, s')+ go x =+ let (s, rest) = go1 "" x+ in if rest == "" then [s] else s : go rest++snakeToCamel :: Text -> Text+snakeToCamel t =+ let (x : xs) = filter (/= "") $ split (== '_') t+ in T.concat (lower' x : fmap upper xs)++camelToSnake :: String -> String+camelToSnake t =+ let l = splitOn' isUpper t+ in intercalate "_" (fmap lower l)
tdlib-gen.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.33.1. -- -- see: https://github.com/sol/hpack ----- hash: e4ba9fc90b907e262d2b05af724e73659a5ef1a547e2cf850905eeca9fb99276+-- hash: 87d8b332f3f3f40e3c87975b071928df3b431394f8d59a56968b8fcf9ffe65ed name: tdlib-gen-version: 0.2.0+version: 0.3.0 synopsis: Codegen for TDLib description: Please see the README on GitHub at <https://github.com/poscat0x04/tdlib-gen#readme> category: Codegen@@ -34,6 +34,7 @@ Language.Haskell.Codegen Language.Haskell.Codegen.TH Processing+ Text.Casing other-modules: Paths_tdlib_gen hs-source-dirs: