diff options
| -rw-r--r-- | Alpha.hs | 8 | ||||
| -rw-r--r-- | Biz/Devalloc.hs | 52 |
2 files changed, 47 insertions, 13 deletions
@@ -164,12 +164,12 @@ a +> b = a Prelude.>>= b infixl 1 +> -- | If-then-else. wutcol -(?:) :: Bool -> (Bool -> p, Bool -> p) -> p -a ?: (f, g) = if a then f a else g a +(?:) :: Bool -> (p, p) -> p +a ?: (b, c) = if a then b else c -- | Inverted if-then-else. wutdot -(?.) :: Bool -> (Bool -> p, Bool -> p) -> p -a ?. (g, f) = if a then f a else g a +(?.) :: Bool -> (p, p) -> p +a ?. (b, c) = if a then c else b -- | Positive assertion. wutgar (?>) :: Bool -> (Bool -> Text -> a) -> Text -> a diff --git a/Biz/Devalloc.hs b/Biz/Devalloc.hs index 2efd8fb..d7a43ea 100644 --- a/Biz/Devalloc.hs +++ b/Biz/Devalloc.hs @@ -83,6 +83,7 @@ import Data.IxSet (Indexable (..), IxSet, ixFun, ixSet, (&&&), (@=)) import qualified Data.IxSet as IxSet import qualified Data.List as List import Data.SafeCopy (base, deriveSafeCopy) +import qualified Data.SafeCopy as SafeCopy import qualified Data.Set as Set import qualified Data.String as String import qualified Data.Text as Text @@ -224,6 +225,28 @@ instance Lucid.ToHtml URL where $(deriveSafeCopy 0 'base ''URL) +data Visibility = Public | Private + deriving (Eq, Ord, Generic, Show, Data, Typeable) + +$(deriveSafeCopy 0 'base ''Visibility) + +data Analysis0 = Analysis0 + { analysisId :: Id.Id Analysis0, + url :: URL, + bareRepo :: FilePath, + blackholes :: [Text], + liabilities :: [Text], + stale :: [(FilePath, Int)], + score :: Integer, + totalFiles :: Integer, + activeAuthors :: [Text], + commit :: Commit, + askedBy :: Id.Id User + } + deriving (Eq, Ord, Generic, Show, Data, Typeable) + +$(deriveSafeCopy 0 'base ''Analysis0) + -- | The result of analyzing a git repo. data Analysis = Analysis { -- | Monotonic incrementing integer id @@ -233,6 +256,8 @@ data Analysis = Analysis url :: URL, -- | Where the repo is stored on the local disk. bareRepo :: FilePath, + -- | If the repo is OSS or not + repoVisibility :: Visibility, -- | A path with no active contributors blackholes :: [Text], -- | A path with < 3 active contributors @@ -252,16 +277,25 @@ data Analysis = Analysis } deriving (Eq, Ord, Generic, Show, Data, Typeable) +instance SafeCopy.Migrate Analysis where + type MigrateFrom Analysis = Analysis0 + migrate Analysis0 {..} = + Analysis + { analysisId = Id.mk (Proxy :: Proxy Analysis) <| Id.untag analysisId, + repoVisibility = Public, + .. + } + $(deriveSafeCopy 0 'base ''Id.Id) $(deriveSafeCopy 0 'base ''Analysis) instance Indexable Analysis where empty = ixSet - [ ixFun <| \a -> [analysisId a], - ixFun <| \a -> [askedBy a], - ixFun <| \a -> [url a], - ixFun <| \a -> [commit a] + [ ixFun <| \Analysis {..} -> [analysisId], + ixFun <| \Analysis {..} -> [askedBy], + ixFun <| \Analysis {..} -> [url], + ixFun <| \Analysis {..} -> [commit] ] -- | The database. @@ -310,7 +344,7 @@ getUsers = do createAnalysis :: Analysis -> Acid.Update Keep Analysis createAnalysis a = do keep@Keep {..} <- get - let newAnalysis = a {analysisId = nextAnalysisId} + let newAnalysis = a {analysisId = nextAnalysisId} :: Analysis put <| keep { analyses = IxSet.insert newAnalysis analyses, @@ -1176,8 +1210,8 @@ instance Lucid.ToHtml Analysis where slen = tshow <. length -- | Run a full analysis on a git repo -analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> IO Analysis -analyze keep askedBy activeAuthors url bareRepo = do +analyze :: Acid.AcidState Keep -> Id.Id User -> [Text] -> URL -> FilePath -> Bool -> IO Analysis +analyze keep askedBy activeAuthors url bareRepo repoPrivate = do commit <- Sha </ Text.strip </ Text.pack </ git ["log", "-n1", "--format=%H"] Acid.query keep (GetAnalysisByUrlAndCommit url commit) +> \case Just analysis -> pure analysis @@ -1223,6 +1257,7 @@ analyze keep askedBy activeAuthors url bareRepo = do ], score = calculateScore numTotal numBlackholes numLiabilities, totalFiles = toInteger <| length tree, + repoVisibility = repoPrivate ?: (Private, Public), .. } |> CreateAnalysis @@ -1314,7 +1349,6 @@ authorsFor gitDir path = ) -- | Clones a repo from GitHub and does the analysis. --- TODO: break this up into fetchGitHub and analyze functions. analyzeGitHub :: Acid.AcidState Keep -> -- | The User asking for the analysis, we auth as them @@ -1339,7 +1373,7 @@ analyzeGitHub keep User {..} depo o r = do Right repo -> do let GitHub.URL url = GitHub.repoHtmlUrl repo bareRepo <- fetchBareRepo depo <. GitHub.getUrl <| GitHub.repoHtmlUrl repo - analyze keep userId activeAuthors (URL url) bareRepo + analyze keep userId activeAuthors (URL url) bareRepo (GitHub.repoPrivate repo) where ghAuth = GitHub.OAuth <| Encoding.encodeUtf8 userGitHubToken ghOwner = GitHub.mkName (Proxy :: Proxy GitHub.Owner) o |