{-# LANGUAGE OverloadedStrings #-}
module OpenSuse.GuessChangeLog ( guessChangeLog, GuessedChangeLog(..) ) where
import OpenSuse.StripSpace
import qualified Control.Foldl as Fold
import Control.Monad.Except
import Data.Algorithm.Diff
import Data.Set ( Set )
import qualified Data.Set as Set
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Prelude hiding ( FilePath )
import Turtle hiding ( l, x, stderr, stdout )
guessChangeLog :: FilePath -> FilePath -> IO GuessedChangeLog
guessChangeLog :: FilePath -> FilePath -> IO GuessedChangeLog
guessChangeLog FilePath
oldDir = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> FilePath -> IO (Either GuessedChangeLog GuessedChangeLog)
guessChangeLog' FilePath
oldDir
guessChangeLog' :: FilePath -> FilePath -> IO (Either GuessedChangeLog GuessedChangeLog)
guessChangeLog' :: FilePath
-> FilePath -> IO (Either GuessedChangeLog GuessedChangeLog)
guessChangeLog' FilePath
oldDir FilePath
newDir = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
Set FilePath
oldCLF <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *) a. MonadIO io => Shell a -> io [a]
listShell (FilePath -> Shell FilePath
findChangeLogFiles FilePath
oldDir)
Set FilePath
newCLF <- forall a. Ord a => [a] -> Set a
Set.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (io :: * -> *) a. MonadIO io => Shell a -> io [a]
listShell (FilePath -> Shell FilePath
findChangeLogFiles FilePath
newDir)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Set FilePath
oldCLF,Set FilePath
newCLF]) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GuessedChangeLog
NoChangeLogFiles)
let clf' :: Set FilePath
clf' = Set FilePath
oldCLF forall a. Ord a => Set a -> Set a -> Set a
`Set.intersection` Set FilePath
newCLF
FilePath
clf <- case forall a. Set a -> [a]
Set.toAscList Set FilePath
clf' of
[] -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Set FilePath -> Set FilePath -> GuessedChangeLog
NoCommonChangeLogFiles Set FilePath
oldCLF Set FilePath
newCLF)
[FilePath
clf] -> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
clf
[FilePath]
_ -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Set FilePath -> GuessedChangeLog
MoreThanOneChangeLogFile Set FilePath
clf')
Text
old <- Text -> Text
stripSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
Text.readFile (FilePath
oldDir FilePath -> FilePath -> FilePath
</> FilePath
clf))
Text
new <- Text -> Text
stripSpace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Text
Text.readFile (FilePath
newDir FilePath -> FilePath -> FilePath
</> FilePath
clf))
let changes :: [Diff Text]
changes = [Diff Text] -> [Diff Text]
cleanupEmptyLines (forall a. Eq a => [a] -> [a] -> [Diff a]
getDiff (Text -> [Text]
Text.lines Text
old) (Text -> [Text]
Text.lines Text
new))
([Diff Text]
top,[Diff Text]
diff) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall a. Diff a -> Bool
inBoth [Diff Text]
changes
([Diff Text]
add,[Diff Text]
foot) = forall a. (a -> Bool) -> [a] -> ([a], [a])
span forall a. Diff a -> Bool
inSecond [Diff Text]
diff
topAddOnly :: Bool
topAddOnly = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Diff a -> Bool
inBoth [Diff Text]
foot
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Diff a -> Bool
inBoth [Diff Text]
changes) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> GuessedChangeLog
UndocumentedUpdate FilePath
clf))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Diff Text]
top forall a. Ord a => a -> a -> Bool
< Int
10) (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> Word -> GuessedChangeLog
UnmodifiedTopIsTooLarge FilePath
clf (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Diff Text]
top))))
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
topAddOnly (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (FilePath -> GuessedChangeLog
NotJustTopAdditions FilePath
clf))
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Text -> GuessedChangeLog
GuessedChangeLog FilePath
clf (Text -> Text
stripSpace ([Text] -> Text
Text.unlines (forall a b. (a -> b) -> [a] -> [b]
map forall a. Diff a -> a
unDiff [Diff Text]
add))))
data GuessedChangeLog
= GuessedChangeLog FilePath Text
| NoChangeLogFiles
| UndocumentedUpdate FilePath
| NoCommonChangeLogFiles (Set FilePath) (Set FilePath)
| MoreThanOneChangeLogFile (Set FilePath)
| UnmodifiedTopIsTooLarge FilePath Word
| NotJustTopAdditions FilePath
deriving (Int -> GuessedChangeLog -> FilePath -> FilePath
[GuessedChangeLog] -> FilePath -> FilePath
GuessedChangeLog -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
showList :: [GuessedChangeLog] -> FilePath -> FilePath
$cshowList :: [GuessedChangeLog] -> FilePath -> FilePath
show :: GuessedChangeLog -> FilePath
$cshow :: GuessedChangeLog -> FilePath
showsPrec :: Int -> GuessedChangeLog -> FilePath -> FilePath
$cshowsPrec :: Int -> GuessedChangeLog -> FilePath -> FilePath
Show)
cleanupEmptyLines :: [Diff Text] -> [Diff Text]
cleanupEmptyLines :: [Diff Text] -> [Diff Text]
cleanupEmptyLines [] = []
cleanupEmptyLines (Second Text
t1 : Both Text
"" Text
"" : Second Text
t2 : [Diff Text]
xs) = forall a b. b -> PolyDiff a b
Second Text
t1 forall a. a -> [a] -> [a]
: forall a b. b -> PolyDiff a b
Second Text
"" forall a. a -> [a] -> [a]
: forall a b. b -> PolyDiff a b
Second Text
t2 forall a. a -> [a] -> [a]
: [Diff Text] -> [Diff Text]
cleanupEmptyLines [Diff Text]
xs
cleanupEmptyLines (First Text
t1 : Both Text
"" Text
"" : First Text
t2 : [Diff Text]
xs) = forall a b. a -> PolyDiff a b
First Text
t1 forall a. a -> [a] -> [a]
: forall a b. a -> PolyDiff a b
First Text
"" forall a. a -> [a] -> [a]
: forall a b. a -> PolyDiff a b
First Text
t2 forall a. a -> [a] -> [a]
: [Diff Text] -> [Diff Text]
cleanupEmptyLines [Diff Text]
xs
cleanupEmptyLines (Diff Text
x:[Diff Text]
xs) = Diff Text
x forall a. a -> [a] -> [a]
: [Diff Text] -> [Diff Text]
cleanupEmptyLines [Diff Text]
xs
inBoth :: Diff a -> Bool
inBoth :: forall a. Diff a -> Bool
inBoth (Both a
_ a
_) = Bool
True
inBoth PolyDiff a a
_ = Bool
False
inSecond :: Diff a -> Bool
inSecond :: forall a. Diff a -> Bool
inSecond (Second a
_) = Bool
True
inSecond PolyDiff a a
_ = Bool
False
unDiff :: Diff a -> a
unDiff :: forall a. Diff a -> a
unDiff (First a
txt) = a
txt
unDiff (Both a
txt a
_) = a
txt
unDiff (Second a
txt) = a
txt
findChangeLogFiles :: FilePath -> Shell FilePath
findChangeLogFiles :: FilePath -> Shell FilePath
findChangeLogFiles FilePath
dirPath =
(Shell Text -> Shell Text) -> Shell FilePath -> Shell FilePath
onFiles (forall a. Pattern a -> Shell Text -> Shell Text
grepText Pattern Text
changelogFilePattern) (FilePath -> FilePath
filename forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Shell FilePath
ls FilePath
dirPath)
changelogFilePattern :: Pattern Text
changelogFilePattern :: Pattern Text
changelogFilePattern = Pattern Char -> Pattern Text
star Pattern Char
dot forall a. Semigroup a => a -> a -> a
<> Text -> Pattern Text
asciiCI Text
"change" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall a. Pattern a -> Pattern ()
invert Pattern Text
codeSuffixPattern
codeSuffixPattern :: Pattern Text
codeSuffixPattern :: Pattern Text
codeSuffixPattern = forall a. [Pattern a] -> Pattern a
choice [forall a. Pattern a -> Pattern a
suffix Pattern Text
".hs", forall a. Pattern a -> Pattern a
suffix Pattern Text
".c", forall a. Pattern a -> Pattern a
suffix Pattern Text
".cpp"]
listShell :: MonadIO io => Shell a -> io [a]
listShell :: forall (io :: * -> *) a. MonadIO io => Shell a -> io [a]
listShell = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (io :: * -> *) a b.
MonadIO io =>
Shell a -> Fold a b -> io b
fold forall a. Fold a [a]
Fold.list