├── .editorconfig ├── .gitignore ├── .hlint.yaml ├── .travis.yml ├── LICENSE ├── Makefile ├── README.md ├── Setup.hs ├── app └── Main.hs ├── example ├── LICENSE ├── README.md ├── Setup.hs ├── app │ └── Main.hs ├── example.cabal ├── src │ ├── Lib.hs │ └── Lib │ │ ├── ArgsTask.hs │ │ ├── BarTask.hs │ │ ├── FooTask.hs │ │ └── PosTask.hs ├── stack.yaml └── test │ └── Spec.hs ├── kale.cabal ├── src ├── Kale.hs └── Kale │ └── Discover.hs ├── stack.yaml └── test ├── KaleSpec.hs └── Spec.hs /.editorconfig: -------------------------------------------------------------------------------- 1 | # http://editorconfig.org 2 | root = true 3 | 4 | [*.*] 5 | indent_style = space 6 | indent_size = 4 7 | end_of_line = lf 8 | charset = utf-8 9 | trim_trailing_whitespace = true 10 | insert_final_newline = true 11 | 12 | [Makefile] 13 | indent_style = tabs 14 | indent_size = 8 15 | 16 | [*.hs] 17 | max_line_length = 80 18 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | .cabal-sandbox/ 3 | cabal.sandbox.config 4 | .stack-work/ 5 | tarballs/ 6 | **/*.hspp 7 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/parsonsmatt/kale/fe187ac5face4eb98925d0f36ad9698329837e1d/.hlint.yaml -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # This is the complex Travis configuration, which is intended for use 2 | # on open source libraries which need compatibility across multiple GHC 3 | # versions, must work with cabal-install, and should be 4 | # cross-platform. For more information and other options, see: 5 | # 6 | # https://docs.haskellstack.org/en/stable/travis_ci/ 7 | # 8 | # Copy these contents into the root directory of your Github project in a file 9 | # named .travis.yml 10 | 11 | # Use new container infrastructure to enable caching 12 | sudo: false 13 | 14 | # Do not choose a language; we provide our own build tools. 15 | language: generic 16 | 17 | # Caching so the next build will be fast too. 18 | cache: 19 | directories: 20 | - $HOME/.ghc 21 | - $HOME/.cabal 22 | - $HOME/.stack 23 | 24 | # The different configurations we want to test. We have BUILD=cabal which uses 25 | # cabal-install, and BUILD=stack which uses Stack. More documentation on each 26 | # of those below. 27 | # 28 | # We set the compiler values here to tell Travis to use a different 29 | # cache file per set of arguments. 30 | # 31 | # If you need to have different apt packages for each combination in the 32 | # matrix, you can use a line such as: 33 | # addons: {apt: {packages: [libfcgi-dev,libgmp-dev]}} 34 | matrix: 35 | include: 36 | # We grab the appropriate GHC and cabal-install versions from hvr's PPA. See: 37 | # https://github.com/hvr/multi-ghc-travis 38 | #- env: BUILD=cabal GHCVER=7.0.4 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 39 | # compiler: ": #GHC 7.0.4" 40 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.0.4,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 41 | #- env: BUILD=cabal GHCVER=7.2.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 42 | # compiler: ": #GHC 7.2.2" 43 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.2.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 44 | #- env: BUILD=cabal GHCVER=7.4.2 CABALVER=1.16 HAPPYVER=1.19.5 ALEXVER=3.1.7 45 | # compiler: ": #GHC 7.4.2" 46 | # addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 47 | - env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7 48 | compiler: ": #GHC 7.10.3" 49 | addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 50 | - env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7 51 | compiler: ": #GHC 8.0.2" 52 | addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 53 | - env: BUILD=cabal GHCVER=8.2.1 CABALVER=2.0 HAPPYVER=1.19.5 ALEXVER=3.1.7 54 | compiler: ": #GHC 8.2.1" 55 | addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 56 | 57 | # Build with the newest GHC and cabal-install. This is an accepted failure, 58 | # see below. 59 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 60 | compiler: ": #GHC HEAD" 61 | addons: {apt: {packages: [cabal-install-head,ghc-head,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}} 62 | 63 | # The Stack builds. We can pass in arbitrary Stack arguments via the ARGS 64 | # variable, such as using --stack-yaml to point to a different file. 65 | - env: BUILD=stack ARGS="" 66 | compiler: ": #stack default" 67 | addons: {apt: {packages: [libgmp-dev]}} 68 | 69 | - env: BUILD=stack ARGS="--resolver lts-6" 70 | compiler: ": #stack 7.10.3" 71 | addons: {apt: {packages: [libgmp-dev]}} 72 | 73 | - env: BUILD=stack ARGS="--resolver lts-7" 74 | compiler: ": #stack 8.0.1" 75 | addons: {apt: {packages: [libgmp-dev]}} 76 | 77 | - env: BUILD=stack ARGS="--resolver lts-8" 78 | compiler: ": #stack 8.0.2" 79 | addons: {apt: {packages: [libgmp-dev]}} 80 | 81 | # Nightly builds are allowed to fail 82 | - env: BUILD=stack ARGS="--resolver nightly" 83 | compiler: ": #stack nightly" 84 | addons: {apt: {packages: [libgmp-dev]}} 85 | 86 | allow_failures: 87 | - env: BUILD=cabal GHCVER=head CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7 88 | - env: BUILD=stack ARGS="--resolver nightly" 89 | 90 | before_install: 91 | # Using compiler above sets CC to an invalid value, so unset it 92 | - unset CC 93 | 94 | # We want to always allow newer versions of packages when building on GHC HEAD 95 | - CABALARGS="" 96 | - if [ "x$GHCVER" = "xhead" ]; then CABALARGS=--allow-newer; fi 97 | 98 | # Download and unpack the stack executable 99 | - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$HOME/.local/bin:/opt/alex/$ALEXVER/bin:/opt/happy/$HAPPYVER/bin:$HOME/.cabal/bin:$PATH 100 | - mkdir -p ~/.local/bin 101 | - | 102 | if [ `uname` = "Darwin" ] 103 | then 104 | travis_retry curl --insecure -L https://www.stackage.org/stack/osx-x86_64 | tar xz --strip-components=1 --include '*/stack' -C ~/.local/bin 105 | else 106 | travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 107 | fi 108 | 109 | # Use the more reliable S3 mirror of Hackage 110 | mkdir -p $HOME/.cabal 111 | echo 'remote-repo: hackage.haskell.org:http://hackage.fpcomplete.com/' > $HOME/.cabal/config 112 | echo 'remote-repo-cache: $HOME/.cabal/packages' >> $HOME/.cabal/config 113 | 114 | if [ "$CABALVER" != "1.16" ] 115 | then 116 | echo 'jobs: $ncpus' >> $HOME/.cabal/config 117 | fi 118 | - stack install hpc-coveralls 119 | 120 | install: 121 | - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" 122 | - if [ -f configure.ac ]; then autoreconf -i; fi 123 | - | 124 | set -ex 125 | case "$BUILD" in 126 | stack) 127 | stack setup 128 | stack build hlint 129 | stack --no-terminal --install-ghc $ARGS test --bench --only-dependencies 130 | ;; 131 | cabal) 132 | cabal --version 133 | travis_retry cabal update 134 | 135 | # Get the list of packages from the stack.yaml file 136 | PACKAGES=$(stack --install-ghc query locals | grep '^ *path' | sed 's@^ *path:@@') 137 | 138 | cabal install --only-dependencies --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES 139 | ;; 140 | esac 141 | set +ex 142 | 143 | script: 144 | - | 145 | set -ex 146 | case "$BUILD" in 147 | stack) 148 | stack --no-terminal $ARGS test --bench --no-run-benchmarks --haddock --no-haddock-deps --coverage 149 | cd example; stack build; cd .. 150 | stack exec -- hlint . 151 | ;; 152 | cabal) 153 | cabal install --enable-tests --enable-benchmarks --force-reinstalls --ghc-options=-O0 --reorder-goals --max-backjumps=-1 $CABALARGS $PACKAGES --enable-coverage 154 | 155 | ORIGDIR=$(pwd) 156 | for dir in $PACKAGES 157 | do 158 | cd $dir 159 | cabal check || [ "$CABALVER" == "1.16" ] 160 | cabal sdist 161 | PKGVER=$(cabal info . | awk '{print $2;exit}') 162 | SRC_TGZ=$PKGVER.tar.gz 163 | cd dist 164 | tar zxfv "$SRC_TGZ" 165 | cd "$PKGVER" 166 | cabal configure --enable-tests --enable-coverage 167 | cabal build 168 | cabal test 169 | hpc-coveralls kale-test 170 | cd $ORIGDIR 171 | done 172 | ;; 173 | esac 174 | set +ex 175 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Matt Parsons (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Matt Parsons nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ghcid: 2 | ghcid --test=":main --fail-fast --color" --command "stack ghci --test --main-is=kale:test:kale-test" 3 | 4 | example-dump: 5 | cd example && stack exec -- ghc src/Lib.hs -E 6 | 7 | hpc: 8 | stack clean && stack build --coverage && stack test --coverage 9 | 10 | test: 11 | stack test && cd example && stack build 12 | 13 | lint: 14 | stack build hlint && stack exec -- hlint . 15 | 16 | .PHONY: ghcid example-dump test hpc 17 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # kale 2 | 3 | [![Build Status](https://travis-ci.org/parsonsmatt/kale.svg?branch=master)](https://travis-ci.org/parsonsmatt/kale) 4 | [![Coverage Status](https://coveralls.io/repos/github/parsonsmatt/kale/badge.svg?branch=master)](https://coveralls.io/github/parsonsmatt/kale?branch=master) 5 | 6 | A tool for creating command line interfaces. 7 | 8 | ## Beginners Welcome! 9 | 10 | This is a great project to contribute to if you'd like experience working on a real-world practical Haskell codebase. 11 | There are a number of issues in the issue tracker, each of which should have enough information to get you started. 12 | If you need more information or would like advice on implementing, feel free to post a comment and I'll be happy to help out. 13 | 14 | ## Developing 15 | 16 | To hack on `kale`, you'll need the [`stack`](https://docs.haskellstack.org/en/stable/README/) build tool. 17 | If you'd prefer to use another tool, please make an issue and file a pull request. 18 | 19 | The `example` directory contains an example project. 20 | This acts as both documentation and an integration test. 21 | While hacking, you can run `make test` to run the unit tests and build the example project. 22 | 23 | You can run `make lint` to run `hlint` over the project. 24 | 25 | For a super fast reload and test runner, use `make ghcid`. 26 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import System.Environment (getArgs) 4 | 5 | import Kale 6 | 7 | main :: IO () 8 | main = do 9 | kaleArgs <- getArgs 10 | case kaleArgs of 11 | src : _ : dest : _ -> do 12 | tasks <- findTasks src 13 | writeTaskModule dest (mkTaskModule src tasks) 14 | _ -> do 15 | putStrLn "Kale doesn't take any arguments." 16 | print kaleArgs 17 | -------------------------------------------------------------------------------- /example/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Matt Parsons (c) 2017 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Matt Parsons nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -------------------------------------------------------------------------------- /example/README.md: -------------------------------------------------------------------------------- 1 | # example 2 | -------------------------------------------------------------------------------- /example/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /example/app/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Lib 4 | 5 | main :: IO () 6 | main = Lib.kaleMain 7 | -------------------------------------------------------------------------------- /example/example.cabal: -------------------------------------------------------------------------------- 1 | name: example 2 | version: 0.1.0.0 3 | -- synopsis: 4 | -- description: 5 | homepage: https://github.com/parsonsmatt/example#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Matt Parsons 9 | maintainer: parsonsmatt@gmail.com 10 | copyright: 2017 Matt Parsons 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | cabal-version: >=1.10 15 | 16 | library 17 | hs-source-dirs: src 18 | exposed-modules: Lib 19 | , Lib.FooTask 20 | , Lib.BarTask 21 | , Lib.ArgsTask 22 | , Lib.PosTask 23 | build-depends: base >= 4.7 && < 5 24 | , kale 25 | default-language: Haskell2010 26 | 27 | executable example-exe 28 | hs-source-dirs: app 29 | main-is: Main.hs 30 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 31 | build-depends: base 32 | , example 33 | default-language: Haskell2010 34 | 35 | test-suite example-test 36 | type: exitcode-stdio-1.0 37 | hs-source-dirs: test 38 | main-is: Spec.hs 39 | build-depends: base 40 | , example 41 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 42 | default-language: Haskell2010 43 | 44 | source-repository head 45 | type: git 46 | location: https://github.com/parsonsmatt/example 47 | -------------------------------------------------------------------------------- /example/src/Lib.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF kale-discover #-} 2 | -------------------------------------------------------------------------------- /example/src/Lib/ArgsTask.hs: -------------------------------------------------------------------------------- 1 | module Lib.ArgsTask where 2 | 3 | data Args = Args { name :: String, age :: Int } 4 | deriving (Eq, Show, Read) 5 | 6 | task :: Args -> IO () 7 | task args = do 8 | putStrLn $ "Your name is: " ++ name args 9 | print (age args) 10 | -------------------------------------------------------------------------------- /example/src/Lib/BarTask.hs: -------------------------------------------------------------------------------- 1 | module Lib.BarTask where 2 | 3 | task :: IO () 4 | task = putStrLn "BarTask" 5 | -------------------------------------------------------------------------------- /example/src/Lib/FooTask.hs: -------------------------------------------------------------------------------- 1 | module Lib.FooTask where 2 | 3 | task :: IO () 4 | task = putStrLn "FooTask" 5 | -------------------------------------------------------------------------------- /example/src/Lib/PosTask.hs: -------------------------------------------------------------------------------- 1 | module Lib.PosTask where 2 | 3 | data Args = Args Int String 4 | 5 | task :: Args -> IO () 6 | task (Args i s) = do 7 | print i 8 | putStrLn s 9 | -------------------------------------------------------------------------------- /example/stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-9.13 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - . 40 | - .. 41 | # Dependency packages to be pulled from upstream that are not in the resolver 42 | # (e.g., acme-missiles-0.3) 43 | # extra-deps: [] 44 | 45 | # Override default flag values for local packages and extra-deps 46 | # flags: {} 47 | 48 | # Extra package databases containing global packages 49 | # extra-package-dbs: [] 50 | 51 | # Control whether we use the GHC we find on the path 52 | # system-ghc: true 53 | # 54 | # Require a specific version of stack, using version ranges 55 | # require-stack-version: -any # Default 56 | # require-stack-version: ">=1.6" 57 | # 58 | # Override the architecture used by stack, especially useful on Windows 59 | # arch: i386 60 | # arch: x86_64 61 | # 62 | # Extra directories used by stack for building 63 | # extra-include-dirs: [/path/to/dir] 64 | # extra-lib-dirs: [/path/to/dir] 65 | # 66 | # Allow a newer minor version of GHC than the snapshot specifies 67 | # compiler-check: newer-minor 68 | -------------------------------------------------------------------------------- /example/test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /kale.cabal: -------------------------------------------------------------------------------- 1 | name: kale 2 | version: 0.1.0.0 3 | synopsis: Automatic command line task discovery 4 | description: Please see README.md for more details. 5 | homepage: https://github.com/parsonsmatt/kale#readme 6 | license: BSD3 7 | license-file: LICENSE 8 | author: Matt Parsons 9 | maintainer: parsonsmatt@gmail.com 10 | copyright: 2017 Matt Parsons 11 | category: Web 12 | build-type: Simple 13 | extra-source-files: README.md 14 | , LICENSE 15 | cabal-version: >=1.10 16 | 17 | library 18 | hs-source-dirs: src 19 | ghc-options: -Wall 20 | exposed-modules: Kale 21 | , Kale.Discover 22 | build-depends: base >= 4.7 && < 5 23 | , directory 24 | , filepath 25 | , transformers 26 | , optparse-generic 27 | default-language: Haskell2010 28 | 29 | executable kale-discover 30 | hs-source-dirs: app 31 | main-is: Main.hs 32 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 33 | build-depends: base 34 | , kale 35 | default-language: Haskell2010 36 | 37 | test-suite kale-test 38 | type: exitcode-stdio-1.0 39 | hs-source-dirs: test 40 | main-is: Spec.hs 41 | build-depends: base 42 | , kale 43 | , hspec 44 | ghc-options: -threaded -rtsopts -with-rtsopts=-N 45 | other-modules: KaleSpec 46 | default-language: Haskell2010 47 | 48 | source-repository head 49 | type: git 50 | location: https://github.com/parsonsmatt/kale 51 | -------------------------------------------------------------------------------- /src/Kale.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE TypeSynonymInstances #-} 4 | 5 | module Kale where 6 | 7 | import Control.Applicative 8 | import Control.Monad 9 | import Control.Monad.IO.Class 10 | import Control.Monad.Trans.Maybe (MaybeT (..)) 11 | import Data.Char (isAlphaNum, isLower, isSpace, 12 | isUpper, toUpper) 13 | import Data.List (find, foldl', groupBy, intercalate, 14 | isPrefixOf, sort, stripPrefix) 15 | import Data.Maybe (catMaybes, fromMaybe) 16 | import System.Directory (doesDirectoryExist, doesFileExist, 17 | getDirectoryContents) 18 | import System.FilePath 19 | 20 | -- | A task can have three sorts of arguments. 21 | data TaskArgs 22 | = NoArgs 23 | -- ^ If the task has no arguments, this is the constructor that we use. 24 | | PositionalArgs [String] 25 | -- ^ Positional arguments store a list of types, with one entry per 26 | -- argument. 27 | | RecordArgs String 28 | -- ^ Record arguments are stored as a whole string with no attempt to 29 | -- parse the types out of them. 30 | deriving (Eq, Show) 31 | 32 | newtype TaskModule 33 | = TaskModule 34 | { unTaskModule :: String 35 | } deriving (Eq, Show) 36 | 37 | newtype TaskName 38 | = TaskName 39 | { unTaskName :: String 40 | } deriving (Eq, Show) 41 | 42 | -- | The 'Task' datatype represents a user-define task. 43 | data Task = Task 44 | { taskModule :: TaskModule 45 | -- ^ The name of the task module. 46 | , taskArgs :: TaskArgs 47 | -- ^ The arguments to provide to the task. 48 | , taskName :: TaskName 49 | -- ^ The name of the task. 50 | } 51 | deriving (Eq, Show) 52 | 53 | newtype TaskModuleContents = TaskModuleContents { unTaskModuleContents :: String } 54 | 55 | -- | Write the given task module contents to the specified file. 56 | writeTaskModule :: FilePath -- ^ The file to write to. 57 | -> TaskModuleContents -- ^ Content of the task module. 58 | -> IO () 59 | writeTaskModule dest taskModuleContents = writeFile dest (unTaskModuleContents taskModuleContents) 60 | 61 | -- | Generates the Haskell source code for a task module. 62 | mkTaskModule :: FilePath -- ^ The path to the module 63 | -> [Task] -- ^ The list of Tasks from which to generate module code. 64 | -> TaskModuleContents 65 | mkTaskModule src tasks = TaskModuleContents $ unlines 66 | [ "{-# LINE 1 " ++ show src ++ " #-}" 67 | , "{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}\n" 68 | , "{-# LANGUAGE DeriveGeneric #-}" 69 | , "{-# LANGUAGE DeriveAnyClass #-}" 70 | , "{-# LANGUAGE OverloadedStrings #-}" 71 | , "{-# LANGUAGE RecordWildCards #-}" 72 | , "" 73 | , "module " ++ pathToModule src ++ " where" 74 | , "" 75 | , "import Kale.Discover" 76 | , unImportList $ importList tasks 77 | , "" 78 | , unCommandSumType $ mkCommandSum tasks 79 | , "" 80 | , unDriver $ driver tasks 81 | ] 82 | 83 | newtype Driver = Driver { unDriver :: String } 84 | 85 | -- | Generates Haskell source code for a module "driver". 86 | driver :: [Task] -- ^ The list of 'Task's from which to generate module code. 87 | -> Driver 88 | driver [] = Driver "" 89 | driver tasks = Driver $ unlines $ 90 | [ "kaleMain :: IO ()" 91 | , "kaleMain = do" 92 | ] ++ indent 2 93 | [ "cmd <- getRecord \"kale-discovery\"" 94 | , "case (cmd :: Command) of" 95 | ] ++ indent 4 (map mkCaseOf tasks) 96 | 97 | newtype CommandSumType = CommandSumType { unCommandSumType :: String } 98 | 99 | -- | Generates Haskell source code for a command data type specific to this module. 100 | mkCommandSum :: [Task] -- ^ The list of 'Task's from which to create commands. 101 | -> CommandSumType 102 | mkCommandSum [] = CommandSumType "" 103 | mkCommandSum tasks = CommandSumType $ "data Command = " 104 | ++ intercalate " | " (map taskToSum tasks) 105 | ++ " deriving (Eq, Show, Read, Generic, ParseRecord)" 106 | 107 | -- | Create a 'TaskName' from the given 'Task'. 108 | taskToSum :: Task -- ^ The 'Task' 109 | -> String 110 | taskToSum task = (unTaskName . taskName $ task) ++ case taskArgs task of 111 | NoArgs -> "" 112 | PositionalArgs args -> " " ++ unwords args 113 | RecordArgs args -> " " ++ args 114 | 115 | -- | Strips all but the record fields from a data type. 116 | -- 117 | -- >>> stripArgs "data Args = Args { foo :: Int }" 118 | -- "RecordArgs \"{ foo :: Int }\"" 119 | stripArgs :: String -> TaskArgs 120 | stripArgs = 121 | RecordArgs 122 | -- . (' ' :) 123 | . (++ "}") 124 | . dropWhile (/= '{') 125 | . takeWhile (/= '}') 126 | 127 | -- | Create the String represntation of the case expression for the given 'Task'. 128 | mkCaseOf :: Task -- ^ The 'Task' 129 | -> String 130 | mkCaseOf task = unwords . filter (not . null) $ 131 | [ unTaskName (taskName task) 132 | , mkCaseMatch task 133 | , "->" 134 | , unTaskModule (taskModule task) ++ "Task.task" 135 | , mkCaseBranch task 136 | ] 137 | 138 | mkCaseBranch :: Task -> String 139 | mkCaseBranch task = 140 | case taskArgs task of 141 | NoArgs -> 142 | "" 143 | RecordArgs _ -> 144 | (unTaskModule . taskModule $ task) ++ "Task.Args {..}" 145 | PositionalArgs args -> 146 | concat 147 | [ "(" 148 | , unTaskModule . taskModule $ task 149 | , "Task.Args " 150 | , mkArgsList args 151 | , ")" 152 | ] 153 | 154 | mkCaseMatch :: Task -> String 155 | mkCaseMatch task = 156 | case taskArgs task of 157 | NoArgs -> "" 158 | RecordArgs _ -> 159 | "{..}" 160 | PositionalArgs args -> 161 | mkArgsList args 162 | 163 | mkArgsList :: [String] -> String 164 | mkArgsList = unwords . zipWith3 (\a i _ -> a ++ show i) (repeat "arg") [0 :: Int ..] 165 | 166 | -- | Indent the given Strings by the given number of spaces. 167 | indent :: Int -- ^ The number of spaces to indent. 168 | -> [String] -- ^ The Strings to indent. 169 | -> [String] 170 | indent n = map (replicate n ' ' ++) 171 | 172 | -- | Returns the 'Task's found at the given FilePath. 173 | findTasks :: FilePath -- ^ The path at which to search for 'Task's. 174 | -> IO [Task] 175 | findTasks src = do 176 | let (dir, file) = splitFileName src 177 | files <- filter (/= file) <$> getFilesRecursive dir 178 | catMaybes <$> traverse (fileToTask dir) files 179 | 180 | -- | Creates a 'Task' from the file at a relative path in a given directory. 181 | fileToTask :: FilePath -- ^ A directory. 182 | -> FilePath -- ^ A path relative to the above directory. 183 | -> IO (Maybe Task) 184 | fileToTask dir file = runMaybeT $ 185 | case reverse $ splitDirectories file of 186 | [] -> 187 | empty 188 | x:xs -> do 189 | name <- MaybeT . pure . stripSuffixes $ x 190 | guard (isValidModuleName name && all isValidModuleName xs) 191 | let fileName = dir file 192 | moduleContents <- liftIO $ FileContent <$> readFile fileName 193 | pure (mkTask moduleContents (casify name) (TaskModule $ intercalate "." (reverse (name : xs)))) 194 | where 195 | stripSuffixes :: String -> Maybe String 196 | stripSuffixes x = 197 | stripSuffix "Task.hs" x <|> stripSuffix "Task.lhs" x 198 | stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] 199 | stripSuffix suffix str = 200 | reverse <$> stripPrefix (reverse suffix) (reverse str) 201 | 202 | newtype FileContent = FileContent { unFileContent :: String } 203 | 204 | -- | Creates a 'Task' from file contents and metadata. 205 | mkTask :: FileContent -- ^ Contents of a task file. 206 | -> TaskName -- ^ The name of the 'Task'. 207 | -> TaskModule -- ^ The name of the task module. 208 | -> Task 209 | mkTask fileContent name mod_ = Task 210 | { taskModule = mod_ 211 | , taskArgs = mkTaskArgs fileContent 212 | , taskName = name 213 | } 214 | 215 | -- | Convert a String in camel case to snake case. 216 | casify :: String -> TaskName 217 | casify str = TaskName . intercalate "_" $ groupBy (\a b -> isUpper a && isLower b) str 218 | 219 | -- | Create 'TaskArgs' from the given task module contents. 220 | mkTaskArgs :: FileContent -> TaskArgs 221 | mkTaskArgs fileContent = case findArgs fileContent of 222 | Nothing -> 223 | NoArgs 224 | Just args -> 225 | if '{' `elem` args 226 | then stripArgs args 227 | else processPositional args 228 | 229 | processPositional :: String -> TaskArgs 230 | processPositional str = 231 | PositionalArgs 232 | . takeWhile (/= "deriving") 233 | . collectTopLevelParens 234 | . dropWhile isSpace 235 | . fromMaybe (error "The Args type must have a single constructor named Args") 236 | . stripPrefix "data Args = Args" 237 | $ collapseSpace str 238 | 239 | collectTopLevelParens :: String -> [String] 240 | collectTopLevelParens = snd . foldr go (0 :: Int, []) 241 | where 242 | go '(' (0, acc) = (1, [] : acc) 243 | go '(' (p, acc) = (p + 1, '(' `consFirst` acc) 244 | go ')' (p, acc) = (p - 1, ')' `consFirst` acc) 245 | go c (0, acc) 246 | | isSpace c = (0, [] : acc) 247 | | otherwise = (0, consFirst c acc) 248 | go c (p, acc) = (p, consFirst c acc) 249 | 250 | -- | Parse task module arguments from the task module file contents. 251 | findArgs :: FileContent -- ^ Task module file contents. 252 | -> Maybe String 253 | findArgs = find ("data Args" `isPrefixOf`) . decs . unFileContent 254 | 255 | -- | Splits a string by declarations. 256 | decs :: String -> [String] 257 | decs = reverse . fmap (collapseSpace . concat . reverse) . foldl' go [] . lines 258 | where 259 | go acc line@(c:_) 260 | | isSpace c || c == '}' = 261 | consFirst line acc 262 | | otherwise = 263 | [line] : acc 264 | go acc [] = acc 265 | 266 | -- | Cons something onto the first list in the list of lists. If there 267 | -- isn't a first list yet, make one. 268 | consFirst :: a -> [[a]] -> [[a]] 269 | consFirst a [] = [[a]] 270 | consFirst a (x:xs) = (a : x) : xs 271 | 272 | -- | Collapses multiple spaces to a single space. 273 | collapseSpace :: String -> String 274 | collapseSpace = unwords . words 275 | 276 | -- | Returns True if the given string is a valid task module name. 277 | -- See `Cabal.Distribution.ModuleName` (http://git.io/bj34) 278 | isValidModuleName :: String -> Bool 279 | isValidModuleName [] = False 280 | isValidModuleName (c:cs) = isUpper c && all isValidModuleChar cs 281 | 282 | -- | Returns True if the given Char is a valid taks module character. 283 | isValidModuleChar :: Char -> Bool 284 | isValidModuleChar c = isAlphaNum c || c == '_' || c == '\'' 285 | 286 | -- | Returns a list of relative paths to all files in the given directory. 287 | getFilesRecursive :: FilePath -- ^ The directory to search. 288 | -> IO [FilePath] 289 | getFilesRecursive baseDir = sort <$> go [] 290 | where 291 | go :: FilePath -> IO [FilePath] 292 | go dir = do 293 | c <- map (dir ) . filter (`notElem` [".", ".."]) <$> getDirectoryContents (baseDir dir) 294 | dirs <- filterM (doesDirectoryExist . (baseDir )) c >>= mapM go 295 | files <- filterM (doesFileExist . (baseDir )) c 296 | return (files ++ concat dirs) 297 | 298 | -- | Derive module name from specified path. 299 | pathToModule :: FilePath -> String 300 | pathToModule f = toUpper m:ms 301 | where 302 | fileName = last $ splitDirectories f 303 | m:ms = takeWhile (/='.') fileName 304 | 305 | newtype ImportList = ImportList { unImportList :: String } deriving (Show) 306 | 307 | -- | Generate imports for a list of specs. 308 | importList :: [Task] -> ImportList 309 | importList = ImportList . unlines . map f 310 | where 311 | f :: Task -> String 312 | f task = "import qualified " ++ unTaskModule (taskModule task) ++ "Task" 313 | -------------------------------------------------------------------------------- /src/Kale/Discover.hs: -------------------------------------------------------------------------------- 1 | module Kale.Discover 2 | ( module GHC.Generics 3 | , module Options.Generic 4 | ) where 5 | 6 | import GHC.Generics 7 | import Options.Generic 8 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-9.13 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - . 40 | # Dependency packages to be pulled from upstream that are not in the resolver 41 | # (e.g., acme-missiles-0.3) 42 | # extra-deps: [] 43 | 44 | # Override default flag values for local packages and extra-deps 45 | # flags: {} 46 | 47 | # Extra package databases containing global packages 48 | # extra-package-dbs: [] 49 | 50 | # Control whether we use the GHC we find on the path 51 | # system-ghc: true 52 | # 53 | # Require a specific version of stack, using version ranges 54 | # require-stack-version: -any # Default 55 | # require-stack-version: ">=1.6" 56 | # 57 | # Override the architecture used by stack, especially useful on Windows 58 | # arch: i386 59 | # arch: x86_64 60 | # 61 | # Extra directories used by stack for building 62 | # extra-include-dirs: [/path/to/dir] 63 | # extra-lib-dirs: [/path/to/dir] 64 | # 65 | # Allow a newer minor version of GHC than the snapshot specifies 66 | # compiler-check: newer-minor -------------------------------------------------------------------------------- /test/KaleSpec.hs: -------------------------------------------------------------------------------- 1 | module KaleSpec where 2 | 3 | import Test.Hspec 4 | 5 | import Kale 6 | 7 | spec :: Spec 8 | spec = do 9 | describe "driver" $ do 10 | it "is empty on empty tasks" $ 11 | unDriver (driver []) `shouldBe` "" 12 | it "has command sum" $ 13 | unDriver (driver [Task (TaskModule "Foo.Bar") NoArgs (TaskName "Bar")]) 14 | `shouldBe` unlines 15 | [ "kaleMain :: IO ()" 16 | , "kaleMain = do" 17 | , " cmd <- getRecord \"kale-discovery\"" 18 | , " case (cmd :: Command) of" 19 | , " Bar -> Foo.BarTask.task" 20 | ] 21 | 22 | describe "casify" $ do 23 | it "simple case works" $ 24 | casify "HelloWorld" `shouldBe` TaskName "Hello_World" 25 | it "acts strange with many caps letters" $ 26 | casify "HTTPWorker" `shouldBe` TaskName "H_T_T_P_Worker" 27 | -- the inputs to casify will always be module names, so the below should 28 | -- not happen 29 | it "acts strange with initial lowercase" $ 30 | casify "lowHigh" `shouldBe` TaskName "l_o_w_High" 31 | 32 | describe "decs" $ do 33 | it "roughly parses declarations" $ do 34 | decs decs1 35 | `shouldBe` 36 | [ "data Foo = Bar" 37 | ] 38 | decs decs0 39 | `shouldBe` 40 | [ "module Foo where" 41 | , "import Asdf" 42 | , "data Foo = Bar | Baz" 43 | ] 44 | it "can parse record syntax" $ 45 | decs decs2 46 | `shouldBe` 47 | [ "module Wat where" 48 | , "data Foo = Foo { fooName :: String , fooAge :: Int }" 49 | ] 50 | 51 | it "can parse weird records" $ 52 | decs decs3 53 | `shouldBe` 54 | [ "data Foo = Foo { fooName :: String}" 55 | ] 56 | 57 | describe "mkCommandSum" $ do 58 | it "is empty on empty task lists" $ 59 | unCommandSumType (mkCommandSum []) `shouldBe` "" 60 | it "lists tasktnames properly" $ 61 | unCommandSumType (mkCommandSum [task0, task1, task2]) 62 | `shouldBe` concat 63 | [ "data Command = Name { foo :: Int }" 64 | , " | Other_Name | Yes_Name Int (Maybe String) deriving (Eq, " 65 | , "Show, Read, Generic, ParseRecord)" 66 | ] 67 | 68 | describe "taskToSum" $ do 69 | it "works with positional arguments" $ do 70 | taskToSum task2 71 | `shouldBe` 72 | "Yes_Name Int (Maybe String)" 73 | 74 | describe "mkCaseOf" $ do 75 | it "works with args" $ do 76 | mkCaseOf task0 77 | `shouldBe` 78 | "Name {..} -> Module.FooTask.task Module.FooTask.Args {..}" 79 | it "works without args" $ do 80 | mkCaseOf task1 81 | `shouldBe` 82 | "Other_Name -> Module1.FooTask.task" 83 | it "works with positional args" $ do 84 | mkCaseOf task2 85 | `shouldBe` 86 | "Yes_Name arg0 arg1 -> Module1.BarTask.task (Module1.BarTask.Args arg0 arg1)" 87 | 88 | describe "mkCaseMatch" $ do 89 | it "works on record arguments" $ do 90 | mkCaseMatch task0 `shouldBe` "{..}" 91 | it "works on empty arguments" $ do 92 | mkCaseMatch task1 `shouldBe` "" 93 | it "works on positional arguments" $ do 94 | mkCaseMatch task2 `shouldBe` "arg0 arg1" 95 | 96 | describe "mkTaskArgs" $ do 97 | it "successfully determines no arguments" $ do 98 | mkTaskArgs (FileContent "module Foo where\n\ntask :: IO ()") 99 | `shouldBe` 100 | NoArgs 101 | 102 | it "successfully determines record args" $ do 103 | mkTaskArgs (FileContent "data Args = Args { foo :: Int }") 104 | `shouldBe` 105 | RecordArgs "{ foo :: Int }" 106 | 107 | it "succeeds on positional args" $ do 108 | mkTaskArgs (FileContent "data Args = Args Int String") 109 | `shouldBe` 110 | PositionalArgs ["Int", "String"] 111 | 112 | 113 | describe "mkTask" $ do 114 | it "is Nothing for taskArgs when fileContent is empty" $ 115 | mkTask (FileContent "") (TaskName "Other_Name") (TaskModule "Module1.Foo") `shouldBe` task1 116 | 117 | describe "pathToModule" $ do 118 | it "parses directories and file extensions" $ 119 | pathToModule "foo/bar.baz" == "Bar" `shouldBe` True 120 | 121 | describe "importList" $ do 122 | it "pulls out taskModules and splits into newlines" $ 123 | unImportList (importList [task0, task1]) `shouldBe` 124 | unlines [ 125 | "import qualified Module.FooTask", 126 | "import qualified Module1.FooTask" 127 | ] 128 | 129 | describe "findArgs" $ do 130 | it "finds record arguments" $ do 131 | findArgs args0 132 | `shouldBe` 133 | Just "data Args = Args { fooId :: Int , barId :: Int }" 134 | it "finds positional arguments" $ do 135 | findArgs args1 136 | `shouldBe` 137 | Just "data Args = Args Int String" 138 | it "works with deriving" $ do 139 | findArgs args2 140 | `shouldBe` 141 | Just "data Args = Args Int String deriving (Eq, Show)" 142 | 143 | describe "processPositional" $ do 144 | it "formats positional arguments" $ do 145 | processPositional "data Args = Args Int String" 146 | `shouldBe` 147 | PositionalArgs ["Int", "String"] 148 | it "works with type constructors" $ do 149 | processPositional "data Args = Args (Maybe String) Int" 150 | `shouldBe` 151 | PositionalArgs ["(Maybe String)", "Int"] 152 | it "is fine with deriving" $ do 153 | processPositional "data Args = Args (Maybe String) Int deriving Show" 154 | `shouldBe` 155 | PositionalArgs ["(Maybe String)", "Int"] 156 | 157 | describe "collectTopLevelParens" $ do 158 | it "works on zero layers" $ do 159 | collectTopLevelParens "hey foo bar" 160 | `shouldBe` 161 | ["hey", "foo", "bar"] 162 | 163 | it "works on two layers" $ do 164 | collectTopLevelParens "hey (foo bar) baz" 165 | `shouldBe` 166 | ["hey", "(foo bar)", "baz"] 167 | 168 | it "works on three layers" $ do 169 | collectTopLevelParens "hey (foo (bar baz)) yes" 170 | `shouldBe` 171 | ["hey", "(foo (bar baz))", "yes"] 172 | 173 | describe "isValidModuleName" $ do 174 | it "must start with uppercase letter" $ do 175 | isValidModuleName "Yes" `shouldBe` True 176 | it "must not be empty" $ do 177 | isValidModuleName "" `shouldBe` False 178 | 179 | 180 | 181 | args0 :: FileContent 182 | args0 = FileContent $ unlines 183 | [ "module ASdf where" 184 | , "" 185 | , "data Args" 186 | , " = Args" 187 | , " { fooId :: Int" 188 | , " , barId :: Int" 189 | , " }" 190 | ] 191 | 192 | args1 :: FileContent 193 | args1 = FileContent $ unlines 194 | [ "module ASdf where" 195 | , "" 196 | , "data Args" 197 | , " = Args Int String" 198 | ] 199 | 200 | args2 :: FileContent 201 | args2 = FileContent $ unlines 202 | [ "module FooBar where" 203 | , "data Args" 204 | , " = Args Int String" 205 | , " deriving (Eq, Show)" 206 | ] 207 | 208 | decs0 :: String 209 | decs0 = unlines 210 | [ "module Foo where" 211 | , "" 212 | , "import Asdf" 213 | , "" 214 | , "data Foo" 215 | , " = Bar" 216 | , " | Baz" 217 | ] 218 | 219 | decs1 :: String 220 | decs1 = unlines 221 | [ "data Foo" 222 | , " = Bar" 223 | ] 224 | 225 | decs2 :: String 226 | decs2 = unlines 227 | [ "module Wat where" 228 | , "data Foo = Foo" 229 | , " { fooName :: String" 230 | , " , fooAge :: Int" 231 | , " }" 232 | ] 233 | 234 | decs3 :: String 235 | decs3 = unlines 236 | [ "data Foo = Foo {" 237 | , " fooName :: String" 238 | , "}" 239 | ] 240 | 241 | task0 :: Task 242 | task0 = Task (TaskModule "Module.Foo") (stripArgs "data Args = Args { foo :: Int }") (TaskName "Name") 243 | 244 | task1 :: Task 245 | task1 = Task (TaskModule "Module1.Foo") NoArgs (TaskName "Other_Name") 246 | 247 | task2 :: Task 248 | task2 = Task 249 | (TaskModule "Module1.Bar") 250 | (PositionalArgs ["Int", "(Maybe String)"]) 251 | (TaskName "Yes_Name") 252 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -F -pgmF hspec-discover #-} 2 | --------------------------------------------------------------------------------