mirror of
https://github.com/github/semantic.git
synced 2024-12-25 07:55:12 +03:00
Read blobs from a directory
This commit is contained in:
parent
1e267ecc88
commit
d2f2764c26
@ -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
10
src/Files.hs
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user