Refactoring script to port to kotlin view extensions

RenameIds.hs

{-# 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 ()