commit
04619604b2
8 changed files with 219 additions and 0 deletions
@ -0,0 +1,3 @@ |
|||||
|
*swp |
||||
|
.stack-work |
||||
|
.git |
@ -0,0 +1,30 @@ |
|||||
|
Copyright Author name here (c) 2017 |
||||
|
|
||||
|
All rights reserved. |
||||
|
|
||||
|
Redistribution and use in source and binary forms, with or without |
||||
|
modification, are permitted provided that the following conditions are met: |
||||
|
|
||||
|
* Redistributions of source code must retain the above copyright |
||||
|
notice, this list of conditions and the following disclaimer. |
||||
|
|
||||
|
* Redistributions in binary form must reproduce the above |
||||
|
copyright notice, this list of conditions and the following |
||||
|
disclaimer in the documentation and/or other materials provided |
||||
|
with the distribution. |
||||
|
|
||||
|
* Neither the name of Author name here nor the names of other |
||||
|
contributors may be used to endorse or promote products derived |
||||
|
from this software without specific prior written permission. |
||||
|
|
||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
@ -0,0 +1,2 @@ |
|||||
|
import Distribution.Simple |
||||
|
main = defaultMain |
@ -0,0 +1,11 @@ |
|||||
|
{-# LANGUAGE OverloadedStrings #-} |
||||
|
module Main where |
||||
|
|
||||
|
import IndexCode |
||||
|
import Control.Applicative |
||||
|
import System.Environment |
||||
|
|
||||
|
main = do |
||||
|
args <- getArgs |
||||
|
files <- getFiles $ head args |
||||
|
mapM_ print files |
@ -0,0 +1,47 @@ |
|||||
|
{-# LANGUAGE OverloadedStrings #-} |
||||
|
|
||||
|
module IndexCode (getFiles) where |
||||
|
|
||||
|
import Control.Monad |
||||
|
import Control.Monad.Extra |
||||
|
import Filesystem.Path |
||||
|
import Data.Sequence ((><)) |
||||
|
import Data.Foldable (toList) |
||||
|
import System.IO.Unsafe (unsafePerformIO) |
||||
|
|
||||
|
import qualified Data.Sequence as S |
||||
|
import qualified Filesystem as FS |
||||
|
import qualified Filesystem.Path.CurrentOS as FP |
||||
|
import qualified Control.Concurrent.Async as CA |
||||
|
import qualified Data.Text as T |
||||
|
|
||||
|
notHidden :: FP.FilePath -> Bool |
||||
|
notHidden fname = (T.head $ decodeFile $ FP.filename fname) /= '.' |
||||
|
|
||||
|
decodeFile :: FP.FilePath -> T.Text |
||||
|
decodeFile fname = |
||||
|
case FP.toText fname of |
||||
|
(Right fname') -> fname' |
||||
|
(Left _) -> "" |
||||
|
|
||||
|
recurse :: S.Seq FP.FilePath -> S.Seq FP.FilePath -> IO (S.Seq FP.FilePath) |
||||
|
recurse files subdirs |
||||
|
| S.null subdirs = return files |
||||
|
| otherwise = do |
||||
|
subs <- CA.mapConcurrently lsRecursive subdirs |
||||
|
return $ files >< (join subs) |
||||
|
|
||||
|
getUnhidden :: S.Seq FP.FilePath -> S.Seq FP.FilePath |
||||
|
getUnhidden = S.filter notHidden |
||||
|
|
||||
|
isDir :: FP.FilePath -> Bool |
||||
|
isDir fname = unsafePerformIO $ FS.isDirectory fname |
||||
|
|
||||
|
lsRecursive :: FP.FilePath -> IO (S.Seq FP.FilePath) |
||||
|
lsRecursive dir = do |
||||
|
fs <- S.fromList <$> FS.listDirectory dir |
||||
|
let (dirs, files) = S.partition isDir fs |
||||
|
recurse files (getUnhidden dirs) |
||||
|
|
||||
|
getFiles :: String -> IO (S.Seq FP.FilePath) |
||||
|
getFiles = lsRecursive . FP.decodeString |
@ -0,0 +1,66 @@ |
|||||
|
# This file was automatically generated by 'stack init' |
||||
|
# |
||||
|
# Some commonly used options have been documented as comments in this file. |
||||
|
# For advanced use and comprehensive documentation of the format, please see: |
||||
|
# http://docs.haskellstack.org/en/stable/yaml_configuration/ |
||||
|
|
||||
|
# Resolver to choose a 'specific' stackage snapshot or a compiler version. |
||||
|
# A snapshot resolver dictates the compiler version and the set of packages |
||||
|
# to be used for project dependencies. For example: |
||||
|
# |
||||
|
# resolver: lts-3.5 |
||||
|
# resolver: nightly-2015-09-21 |
||||
|
# resolver: ghc-7.10.2 |
||||
|
# resolver: ghcjs-0.1.0_ghc-7.10.2 |
||||
|
# resolver: |
||||
|
# name: custom-snapshot |
||||
|
# location: "./custom-snapshot.yaml" |
||||
|
resolver: lts-8.5 |
||||
|
|
||||
|
# User packages to be built. |
||||
|
# Various formats can be used as shown in the example below. |
||||
|
# |
||||
|
# packages: |
||||
|
# - some-directory |
||||
|
# - https://example.com/foo/bar/baz-0.0.2.tar.gz |
||||
|
# - location: |
||||
|
# git: https://github.com/commercialhaskell/stack.git |
||||
|
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
|
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
|
# extra-dep: true |
||||
|
# subdirs: |
||||
|
# - auto-update |
||||
|
# - wai |
||||
|
# |
||||
|
# A package marked 'extra-dep: true' will only be built if demanded by a |
||||
|
# non-dependency (i.e. a user package), and its test suites and benchmarks |
||||
|
# will not be run. This is useful for tweaking upstream packages. |
||||
|
packages: |
||||
|
- '.' |
||||
|
# Dependency packages to be pulled from upstream that are not in the resolver |
||||
|
# (e.g., acme-missiles-0.3) |
||||
|
extra-deps: [] |
||||
|
|
||||
|
# Override default flag values for local packages and extra-deps |
||||
|
flags: {} |
||||
|
|
||||
|
# Extra package databases containing global packages |
||||
|
extra-package-dbs: [] |
||||
|
|
||||
|
# Control whether we use the GHC we find on the path |
||||
|
# system-ghc: true |
||||
|
# |
||||
|
# Require a specific version of stack, using version ranges |
||||
|
# require-stack-version: -any # Default |
||||
|
# require-stack-version: ">=1.1" |
||||
|
# |
||||
|
# Override the architecture used by stack, especially useful on Windows |
||||
|
# arch: i386 |
||||
|
# arch: x86_64 |
||||
|
# |
||||
|
# Extra directories used by stack for building |
||||
|
# extra-include-dirs: [/path/to/dir] |
||||
|
# extra-lib-dirs: [/path/to/dir] |
||||
|
# |
||||
|
# Allow a newer minor version of GHC than the snapshot specifies |
||||
|
# compiler-check: newer-minor |
@ -0,0 +1,58 @@ |
|||||
|
name: structured |
||||
|
version: 0.1.0.0 |
||||
|
-- synopsis: |
||||
|
-- description: |
||||
|
homepage: https://github.com/githubuser/structured#readme |
||||
|
license: BSD3 |
||||
|
license-file: LICENSE |
||||
|
author: Author name here |
||||
|
maintainer: example@example.com |
||||
|
copyright: 2017 Author name here |
||||
|
category: Web |
||||
|
build-type: Simple |
||||
|
extra-source-files: README.md |
||||
|
cabal-version: >=1.10 |
||||
|
|
||||
|
library |
||||
|
extensions: OverloadedStrings |
||||
|
hs-source-dirs: src |
||||
|
exposed-modules: IndexCode |
||||
|
build-depends: base >= 4.7 && < 5 |
||||
|
, system-fileio |
||||
|
, system-filepath |
||||
|
, async |
||||
|
, text |
||||
|
, extra |
||||
|
, parallel |
||||
|
, containers |
||||
|
default-language: Haskell2010 |
||||
|
|
||||
|
executable structured-exe |
||||
|
extensions: OverloadedStrings |
||||
|
hs-source-dirs: app |
||||
|
main-is: Main.hs |
||||
|
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N |
||||
|
build-depends: base |
||||
|
, structured |
||||
|
, system-fileio |
||||
|
, filepath |
||||
|
, system-filepath |
||||
|
, async |
||||
|
, text |
||||
|
, extra |
||||
|
, parallel |
||||
|
, containers |
||||
|
default-language: Haskell2010 |
||||
|
|
||||
|
test-suite structured-test |
||||
|
type: exitcode-stdio-1.0 |
||||
|
hs-source-dirs: test |
||||
|
main-is: Spec.hs |
||||
|
build-depends: base |
||||
|
, structured |
||||
|
ghc-options: -threaded -rtsopts -with-rtsopts=-N |
||||
|
default-language: Haskell2010 |
||||
|
|
||||
|
source-repository head |
||||
|
type: git |
||||
|
location: https://github.com/githubuser/structured |
@ -0,0 +1,2 @@ |
|||||
|
main :: IO () |
||||
|
main = putStrLn "Test suite not yet implemented" |
Loading…
Reference in new issue