wes
8 years ago
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