github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-26 00:12:29 +03:00
Code Issues Projects Releases Wiki Activity

Read blobs from a directory

Browse Source
This commit is contained in:
joshvera 2017-10-17 12:48:27 -04:00
parent 1e267ecc88
commit d2f2764c26
2 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic-diff.cabal
View File

@ -98,6 +98,7 @@ library
, free , free
, freer-cofreer , freer-cofreer
, gitrev , gitrev
, Glob
, hashable , hashable
, kdt , kdt
, mersenne-random-pure64 , mersenne-random-pure64

10
src/Files.hs
View File

@ -1,8 +1,9 @@
{-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields, ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings, TypeSynonymInstances, DeriveAnyClass, DuplicateRecordFields, ScopedTypeVariables, TupleSections #-}
module Files module Files
( readFile ( readFile
, readBlobPairsFromHandle , readBlobPairsFromHandle
, readBlobsFromHandle , readBlobsFromHandle
, readBlobsFromDir
, languageForFilePath , languageForFilePath
) where ) where
@ -25,6 +26,7 @@ import Prelude hiding (readFile)
import System.Exit import System.Exit
import System.FilePath import System.FilePath
import System.IO (Handle) import System.IO (Handle)
import System.FilePath.Glob
import Text.Read import Text.Read
-- | Read a utf8-encoded file to a 'Blob'. -- | Read a utf8-encoded file to a 'Blob'.
@ -51,6 +53,12 @@ readBlobsFromHandle :: MonadIO m => Handle -> m [Blob.Blob]
readBlobsFromHandle = fmap toBlobs . readFromHandle readBlobsFromHandle = fmap toBlobs . readFromHandle
where toBlobs BlobParse{..} = fmap toBlob blobs where toBlobs BlobParse{..} = fmap toBlob blobs
readBlobsFromDir :: MonadIO m => FilePath -> m [Blob.Blob]
readBlobsFromDir path = do
paths <- liftIO (glob (path </> "**/*.rb"))
let paths' = catMaybes $ fmap (\p -> (p,) . Just <$> languageForFilePath p) paths
traverse (uncurry readFile) paths'
readFromHandle :: (FromJSON a, MonadIO m) => Handle -> m a readFromHandle :: (FromJSON a, MonadIO m) => Handle -> m a
readFromHandle h = do readFromHandle h = do
input <- liftIO $ BL.hGetContents h input <- liftIO $ BL.hGetContents h