Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- {-# LANGUAGE OverloadedStrings #-}
- module Main where
- import Turtle
- import Prelude hiding (FilePath)
- import qualified Data.Text as T
- import qualified Control.Foldl as Fold
- import Data.Maybe
- import Control.Monad (filterM)
- data ViewBindings = ViewBindings { controllerFile :: FilePath
- , layoutFile :: FilePath
- , bindings :: [Binding]
- }
- deriving (Eq, Show)
- -- property name, property type, property layout id
- data Binding = Binding { propertyName :: Text
- , propertyType :: Text
- , propertyLayoutId :: Text
- }
- deriving (Eq, Show)
- -- pasted from foldl-1.3.5 to not mess with stack for now
- prefilter :: (a -> Bool) -> Fold a r -> Fold a r
- prefilter f (Fold step begin done) = Fold step' begin done
- where
- step' x a = if f a then step x a else x
- {-# INLINABLE prefilter #-}
- snakeToCamel :: T.Text -> T.Text
- snakeToCamel t = case T.splitOn "_" t of
- [] -> t
- (w:ws) -> T.concat (T.toLower w : map T.toTitle ws)
- kotlinIdPattern :: Pattern Text
- kotlinIdPattern = do
- rid <- text "R.id."
- identifier <- plus (alphaNum <|> char '_')
- return $ rid <> (snakeToCamel identifier)
- bindViewPattern :: Pattern Binding
- bindViewPattern = do
- text "val"
- plus space
- propName <- plus alphaNum
- char ':'
- plus space
- propType <- plus alphaNum
- plus space
- text "by"
- plus space
- text "BindView(R.id."
- propLayoutId <- plus (alphaNum <|> char '_')
- char ')'
- return $ Binding propName propType propLayoutId
- -- finds a layout identifier for controller views
- viewLayoutPattern :: Pattern Text
- viewLayoutPattern = do
- text "inflater.inflate(R.layout."
- layoutId <- text "content_" <> plus (alphaNum <|> char '_')
- char ','
- return layoutId
- -- finds a layout "@id"/"@+id" attributes, returns only name part,
- -- i.e. "@+id/some_id" -> "some_id"
- idAttrPattern :: Pattern Text
- idAttrPattern = do
- char '@'
- optional (char '+')
- text "id/"
- propLayoutId <- plus (alphaNum <|> char '_')
- return propLayoutId
- argsParser :: Parser FilePath
- argsParser = argPath "SRC_DIR" "A source directory to find file to refactor"
- nonNullShell :: Shell a -> IO Bool
- nonNullShell sh = not <$> fold sh Fold.null
- findLayoutFileById :: Text -> FilePath -> IO (Maybe FilePath)
- findLayoutFileById lid dir = fold (find (suffix layoutFileName) dir) $ prefilter (not . isInBuildDir) Fold.head
- where layoutFileName = text (lid <> ".xml")
- isInBuildDir fp = any (\p -> p == fromText "build/") $ splitDirectories fp
- extractLayoutFilePath :: FilePath -> FilePath -> IO (Maybe FilePath)
- extractLayoutFilePath dir fp = do
- let inputShell = input fp
- let grepShell = grep (has viewLayoutPattern) inputShell
- let sedShell = sed (has viewLayoutPattern) grepShell
- layoutId <- fold sedShell Fold.head
- case layoutId of
- Just id -> findLayoutFileById (lineToText id) dir
- Nothing -> return Nothing
- extractViewBindings :: FilePath -> IO [Binding]
- extractViewBindings fp = do
- let inputShell = input fp
- let grepShell = lineToText <$> grep (has bindViewPattern) inputShell
- let matchFirst p t = head $ match p t
- let sedShell = matchFirst (has bindViewPattern) <$> grepShell
- fold sedShell Fold.list
- main :: IO ()
- main = do
- sourceDir <- options "Refactors BindView delegate to kotlin extensions" argsParser
- files <- fold (find (suffix ".kt") sourceDir) Fold.list
- let fileShells = map (\filePath -> (filePath, grep (has bindViewPattern) (input filePath))) files
- filtered <- filterM (\(_, sh) -> nonNullShell sh) fileShells
- let filesWithBinds = map fst filtered
- layoutFilesMaybes <- sequence $ map (extractLayoutFilePath sourceDir) filesWithBinds
- viewBindings <- sequence $ map extractViewBindings filesWithBinds
- let layoutFiles = map fromJust layoutFilesMaybes
- let bindings = zipWith3 (\cf lf vb -> ViewBindings cf lf vb) filesWithBinds layoutFiles viewBindings
- do if (length filesWithBinds /= length bindings) then error "not all bindings found!" else return ()
- putStrLn ("found " ++ (show (length bindings)) ++ " files with bindings")
- return ()
Add Comment
Please, Sign In to add comment