Send Beginners mailing list submissions to
        beginners@haskell.org

To subscribe or unsubscribe via the World Wide Web, visit
        http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners
or, via email, send a message with subject or body 'help' to
        beginners-requ...@haskell.org

You can reach the person managing the list at
        beginners-ow...@haskell.org

When replying, please edit your Subject line so it is more specific
than "Re: Contents of Beginners digest..."


Today's Topics:

   1. Re:  using Shake to compile c++ (David McBride)
   2. Re:  using Shake to compile c++ (David McBride)
   3. Re:  using Shake to compile c++ (Roger Mason)


----------------------------------------------------------------------

Message: 1
Date: Sat, 8 Jul 2017 07:37:58 -0400
From: David McBride <toa...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] using Shake to compile c++
Message-ID:
        <can+tr40fvfseltfirg2wbkeffbcws9bc1ssqcu1_y33t_my...@mail.gmail.com>
Content-Type: text/plain; charset="UTF-8"

The easy option is to just use command instead of cmd.  Variadic
functions are always a little weird to type check.

command_ [] "pkg-config" ["glib-2.0","--cflags"]

That will *probably* solve the ambiguity in both lines, but I haven't tested.

On Sat, Jul 8, 2017 at 7:19 AM, Roger Mason <rma...@mun.ca> wrote:
> Hello,
>
> I am trying the Shake build system to compile some c++.  I would
> appreciate some advice on how to use the result of a call to pkg-config
> in constructing a compiler command.  This is what I have currently in 
> Build.hs:
>
> import Development.Shake
> import Development.Shake.Command
> import Development.Shake.FilePath
> import Development.Shake.Util
>
> main :: IO ()
> main = shakeArgs shakeOptions{shakeFiles="bin"} $ do
>     want ["bin/makelist", "bin/makejpeg" <.> exe]
>
>     phony "clean" $ do
>         putNormal "Cleaning files in _build"
>         removeFilesAfter "bin" ["//*"]
>
>     "bin/makelist" <.> exe %> \out -> do
>         cs <- getDirectoryFiles "" ["src/MakeList.cxx"]
>         let os = ["objects" </> c -<.> "o" | c <- cs]
>         need os
>         cmd "c++ -o" [out] os
>
>     "bin/makejpeg" <.> exe %> \out -> do
>         cs <- getDirectoryFiles "" ["src/MakeJpeg.cxx"]
>         let os = ["objects" </> c -<.> "o" | c <- cs]
>         need os
>         cmd "c++ -o" [out] os
>
>     "objects//*.o" %> \out -> do
>         let c = dropDirectory1 $ out -<.> "cxx"
>         let m = out -<.> "m"
>         let i = cmd "pkg-config glib-2.0 --cflags"
>         () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
>         needMakefileDependencies m
>
> This is the output from 'stack runhaskell Build.sh':
>
> Build.hs:29:17: error:
>     * Ambiguous type variable `t0' arising from a use of `cmd'
>       prevents the constraint `(CmdArguments t0)' from being solved.
>       Relevant bindings include i :: t0 (bound at Build.hs:29:13)
>       Probable fix: use a type annotation to specify what `t0' should be.
>       These potential instances exist:
>         instance CmdResult r => CmdArguments (IO r)
>           -- Defined in `Development.Shake.Command'
>         instance CmdResult r => CmdArguments (Action r)
>           -- Defined in `Development.Shake.Command'
>         instance (Development.Shake.Command.Arg a, CmdArguments r) =>
>                  CmdArguments (a -> r)
>           -- Defined in `Development.Shake.Command'
>         ...plus one other
>         (use -fprint-potential-instances to see them all)
>     * In the expression: cmd "pkg-config glib-2.0 --cflags"
>       In an equation for `i': i = cmd "pkg-config glib-2.0 --cflags"
>       In the expression:
>         do { let c = dropDirectory1 $ out -<.> "cxx";
>              let m = out -<.> "m";
>              let i = cmd "pkg-config glib-2.0 --cflags";
>              () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
>              .... }
>
> Build.hs:30:15: error:
>     * Ambiguous type variable `t0' arising from a use of `cmd'
>       prevents the constraint `(Development.Shake.Command.Arg
>                                   [t0])' from being solved.
>       Relevant bindings include i :: t0 (bound at Build.hs:29:13)
>       Probable fix: use a type annotation to specify what `t0' should be.
>       These potential instances exist:
>         instance Development.Shake.Command.Arg [CmdOption]
>           -- Defined in `Development.Shake.Command'
>         instance Development.Shake.Command.Arg [String]
>           -- Defined in `Development.Shake.Command'
>         instance Development.Shake.Command.Arg String
>           -- Defined in `Development.Shake.Command'
>     * In a stmt of a 'do' block:
>         () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
>       In the expression:
>         do { let c = dropDirectory1 $ out -<.> "cxx";
>              let m = out -<.> "m";
>              let i = cmd "pkg-config glib-2.0 --cflags";
>              () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
>              .... }
>       In the second argument of `(%>)', namely
>         `\ out
>            -> do { let ...;
>                    let ...;
>                    .... }'
>
> I would appreciate any help in getting the output of the call to
> pkg-config into the compiler invocation.
>
> Thanks,
> Roger
> _______________________________________________
> Beginners mailing list
> Beginners@haskell.org
> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

Message: 2
Date: Sat, 8 Jul 2017 07:38:24 -0400
From: David McBride <toa...@gmail.com>
To: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] using Shake to compile c++
Message-ID:
        <can+tr41mznhnom1ppbtm5l1sfuvmz7vbhpwh4zj2mzggeae...@mail.gmail.com>
Content-Type: text/plain; charset="UTF-8"

Sorry that should have been command, not command_ which is very different.

On Sat, Jul 8, 2017 at 7:37 AM, David McBride <toa...@gmail.com> wrote:
> The easy option is to just use command instead of cmd.  Variadic
> functions are always a little weird to type check.
>
> command_ [] "pkg-config" ["glib-2.0","--cflags"]
>
> That will *probably* solve the ambiguity in both lines, but I haven't tested.
>
> On Sat, Jul 8, 2017 at 7:19 AM, Roger Mason <rma...@mun.ca> wrote:
>> Hello,
>>
>> I am trying the Shake build system to compile some c++.  I would
>> appreciate some advice on how to use the result of a call to pkg-config
>> in constructing a compiler command.  This is what I have currently in 
>> Build.hs:
>>
>> import Development.Shake
>> import Development.Shake.Command
>> import Development.Shake.FilePath
>> import Development.Shake.Util
>>
>> main :: IO ()
>> main = shakeArgs shakeOptions{shakeFiles="bin"} $ do
>>     want ["bin/makelist", "bin/makejpeg" <.> exe]
>>
>>     phony "clean" $ do
>>         putNormal "Cleaning files in _build"
>>         removeFilesAfter "bin" ["//*"]
>>
>>     "bin/makelist" <.> exe %> \out -> do
>>         cs <- getDirectoryFiles "" ["src/MakeList.cxx"]
>>         let os = ["objects" </> c -<.> "o" | c <- cs]
>>         need os
>>         cmd "c++ -o" [out] os
>>
>>     "bin/makejpeg" <.> exe %> \out -> do
>>         cs <- getDirectoryFiles "" ["src/MakeJpeg.cxx"]
>>         let os = ["objects" </> c -<.> "o" | c <- cs]
>>         need os
>>         cmd "c++ -o" [out] os
>>
>>     "objects//*.o" %> \out -> do
>>         let c = dropDirectory1 $ out -<.> "cxx"
>>         let m = out -<.> "m"
>>         let i = cmd "pkg-config glib-2.0 --cflags"
>>         () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
>>         needMakefileDependencies m
>>
>> This is the output from 'stack runhaskell Build.sh':
>>
>> Build.hs:29:17: error:
>>     * Ambiguous type variable `t0' arising from a use of `cmd'
>>       prevents the constraint `(CmdArguments t0)' from being solved.
>>       Relevant bindings include i :: t0 (bound at Build.hs:29:13)
>>       Probable fix: use a type annotation to specify what `t0' should be.
>>       These potential instances exist:
>>         instance CmdResult r => CmdArguments (IO r)
>>           -- Defined in `Development.Shake.Command'
>>         instance CmdResult r => CmdArguments (Action r)
>>           -- Defined in `Development.Shake.Command'
>>         instance (Development.Shake.Command.Arg a, CmdArguments r) =>
>>                  CmdArguments (a -> r)
>>           -- Defined in `Development.Shake.Command'
>>         ...plus one other
>>         (use -fprint-potential-instances to see them all)
>>     * In the expression: cmd "pkg-config glib-2.0 --cflags"
>>       In an equation for `i': i = cmd "pkg-config glib-2.0 --cflags"
>>       In the expression:
>>         do { let c = dropDirectory1 $ out -<.> "cxx";
>>              let m = out -<.> "m";
>>              let i = cmd "pkg-config glib-2.0 --cflags";
>>              () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
>>              .... }
>>
>> Build.hs:30:15: error:
>>     * Ambiguous type variable `t0' arising from a use of `cmd'
>>       prevents the constraint `(Development.Shake.Command.Arg
>>                                   [t0])' from being solved.
>>       Relevant bindings include i :: t0 (bound at Build.hs:29:13)
>>       Probable fix: use a type annotation to specify what `t0' should be.
>>       These potential instances exist:
>>         instance Development.Shake.Command.Arg [CmdOption]
>>           -- Defined in `Development.Shake.Command'
>>         instance Development.Shake.Command.Arg [String]
>>           -- Defined in `Development.Shake.Command'
>>         instance Development.Shake.Command.Arg String
>>           -- Defined in `Development.Shake.Command'
>>     * In a stmt of a 'do' block:
>>         () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
>>       In the expression:
>>         do { let c = dropDirectory1 $ out -<.> "cxx";
>>              let m = out -<.> "m";
>>              let i = cmd "pkg-config glib-2.0 --cflags";
>>              () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
>>              .... }
>>       In the second argument of `(%>)', namely
>>         `\ out
>>            -> do { let ...;
>>                    let ...;
>>                    .... }'
>>
>> I would appreciate any help in getting the output of the call to
>> pkg-config into the compiler invocation.
>>
>> Thanks,
>> Roger
>> _______________________________________________
>> Beginners mailing list
>> Beginners@haskell.org
>> http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

Message: 3
Date: Sat, 08 Jul 2017 09:27:01 -0230
From: Roger Mason <rma...@mun.ca>
To: David McBride <toa...@gmail.com>
Cc: The Haskell-Beginners Mailing List - Discussion of primarily
        beginner-level topics related to Haskell <beginners@haskell.org>
Subject: Re: [Haskell-beginners] using Shake to compile c++
Message-ID: <y6560f3p2eq....@mun.ca>
Content-Type: text/plain

David McBride <toa...@gmail.com> writes:

> Sorry that should have been command, not command_ which is very different.
>
> On Sat, Jul 8, 2017 at 7:37 AM, David McBride <toa...@gmail.com> wrote:
>> The easy option is to just use command instead of cmd.  Variadic
>> functions are always a little weird to type check.
>>
>> command_ [] "pkg-config" ["glib-2.0","--cflags"]
>>
>> That will *probably* solve the ambiguity in both lines, but I haven't tested.

Thank you for your replies.

This is what I have now:

 "objects//*.o" %> \out -> do
        let c = dropDirectory1 $ out -<.> "cxx"
        let m = out -<.> "m"
        let i = command [] "pkg-config" ["glib-2.0","--cflags"]
        () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
        needMakefileDependencies m

That produces:

Build.hs:29:17: error:
    * Ambiguous type variable `r0' arising from a use of `command'
      prevents the constraint `(CmdResult r0)' from being solved.
      Relevant bindings include i :: Action r0 (bound at Build.hs:29:13)
      Probable fix: use a type annotation to specify what `r0' should be.
      These potential instances exist:
        instance CmdResult CmdLine
          -- Defined in `Development.Shake.Command'
        instance CmdResult CmdTime
          -- Defined in `Development.Shake.Command'
        instance CmdResult Exit -- Defined in `Development.Shake.Command'
        ...plus 9 others
        ...plus two instances involving out-of-scope types
        (use -fprint-potential-instances to see them all)
    * In the expression:
        command [] "pkg-config" ["glib-2.0", "--cflags"]
      In an equation for `i':
          i = command [] "pkg-config" ["glib-2.0", "--cflags"]
      In the expression:
        do { let c = dropDirectory1 $ out -<.> "cxx";
             let m = out -<.> "m";
             let i = command ... "pkg-config" ...;
             () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
             .... }

Build.hs:30:15: error:
    * No instance for (Development.Shake.Command.Arg [Action r0])
        arising from a use of `cmd'
    * In a stmt of a 'do' block:
        () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i]
      In the expression:
        do { let c = dropDirectory1 $ out -<.> "cxx";
             let m = out -<.> "m";
             let i = command ... "pkg-config" ...;
             () <- cmd "c++ -c" [c] "-o" [out] "-MMD -MF" [m] [i];
             .... }
      In the second argument of `(%>)', namely
        `\ out
           -> do { let ...;
                   let ...;
                   .... }'

Thanks again,
Roger


------------------------------

Subject: Digest Footer

_______________________________________________
Beginners mailing list
Beginners@haskell.org
http://mail.haskell.org/cgi-bin/mailman/listinfo/beginners


------------------------------

End of Beginners Digest, Vol 109, Issue 11
******************************************

Reply via email to