[Haskell-cafe] Documentation operator
Clark Gaebel
cgaebel at uwaterloo.ca
Thu Dec 27 22:40:35 CET 2012
I love the idea, but it seems like it's a bit too early in Haskell's life
to implement it. Not everyone's on GHC 7.6.1+.
- Clark
On Thu, Dec 27, 2012 at 3:20 PM, Iavor Diatchki <iavor.diatchki at gmail.com>wrote:
> Hi,
>
> I think that this is a neat idea that should be explored more! GHC's
> parser has a bunch of awkward duplication to handle attaching documentation
> to types, and it'd be cool if we could replace it with an actual language
> construct.
>
> Happy holidays!
> -Iavor
>
> On Wed, Dec 26, 2012 at 3:27 AM, Christopher Done <chrisdone at gmail.com>wrote:
>
>> Hello chums,
>>
>> I've been playing around with an idea, something that has obvious pros
>> and cons, but I'll sell it to you because there might be some positive
>> ideas out of it. Consider the following operator:
>>
>> {-# LANGUAGE TypeOperators, DataKinds, KindSignatures #-}
>>
>> module Docs where
>>
>> import GHC.TypeLits
>>
>> type a ? (sym :: Symbol) = a
>>
>> First I'll describe how I'd want to use this and then what I think
>> are the advantages and disadvantages.
>>
>> I call this (?) operator “the documentation operator”, to be used for:
>>
>> * Things that either don't belong or can't be encoded in the type
>> system, or for things need to be in English.
>> * Things that cannot be encoded in Haddock.
>>
>> The simple case of ye olde days:
>>
>> -- | Lorem ipsum dolor sit amet. Suspendisse lacinia nibh et
>> -- leo. Aenean auctor aliquam dapibus.
>> loremIpsum :: Int -> Int -> String
>>
>> Which has since been somewhat evolved into:
>>
>> loremIpsum :: Int -- ^ Lorem ipsum dolor sit amet.
>> -> Int -- ^ Suspendisse lacinia nibh et leo.
>> -> String -- ^ Aenean auctor aliquam dapibus.
>>
>> But could now be written:
>>
>> loremIpsum :: Int ? "Lorem ipsum dolor sit amet."
>> -> Int ? "Suspendisse lacinia nibh et leo."
>> -> String ? "Aenean auctor aliquam dapibus."
>>
>> Here is a contrived case I'll use later on:
>>
>> data Person = Person
>>
>> describeAge :: Int ? "an age" -> String ? "description of their
>> elderliness"
>> describeAge n = undefined
>>
>> personAge :: Person ? "a person" -> Int ? "their age"
>> personAge = undefined
>>
>> One could also encode previously informal specifications more formally,
>> so that
>>
>> -- | The action 'hFlush' @hdl@ causes any items buffered for output
>> -- in handle @hdl@ to be sent immediately to the operating system.
>> --
>> -- This operation may fail with:
>> --
>> -- * 'isFullError' if the device is full;
>> --
>> -- * 'isPermissionError' if a system resource limit would be
>> exceeded.
>> -- It is unspecified whether the characters in the buffer are
>> discarded
>> -- or retained under these circumstances.
>> hFlush :: Handle -> IO ()
>> hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
>>
>> with
>>
>> type Throws ex (docs :: Symbol) = docs
>>
>> could now be written
>>
>> hFlush :: Handle ? "flush buffered items for output on this handle"
>> -> IO ()
>> ? Throws IsFullError "if the device is full"
>> ? Throws IsPermissionError
>> "if a system resource limit would be exceeded. It is \
>> \unspecified whether the characters in the buffer are \
>> \discarded or retained under these circumstances."
>> hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
>>
>> With this in place, in GHCi you get documentation "lookup" for free:
>>
>> > :t hFlush
>> hFlush
>> :: (Handle ? "flush buffered items for output on this handle")
>> -> (IO () ? Throws IsFullError "if the device is full")
>> ? Throws
>> IsPermissionError
>> "if a system resource limit would be exceeded. It is
>> unspecified
>> whether the characters in the buffer are discarded or
>> retained
>> under these circumstances."
>>
>> And you get function composition, or “documentation composition” for free:
>>
>> > :t describeAge . personAge
>> describeAge . personAge
>> :: (Person ? "a person")
>> -> String ? "description of their elderliness"
>>
>> We could have a :td command to print it with docs, and otherwise docs
>> could be stripped out trivially by removing the ? annotations:
>>
>> > :t describeAge . personAge
>> describeAge . personAge
>> :: Person -> String
>> > :td describeAge . personAge
>> describeAge . personAge
>> :: (Person ? "a person")
>> -> String ? "description of their elderliness"
>>
>> You could even add clever printing of such “documentation types”:
>>
>> > :t hFlush
>> hFlush
>> :: Handle — flush buffered items for output on this handle
>> -> IO ()
>> Throws IsFullError if the device is full"
>> Throws IsPermissionError if a system resource limit would be
>> exceeded. It is unspecified whether the characters in the buffer
>> are discarded or retained under these circumstances."
>>
>> Unfortunately it doesn't work with monadic composition, of course.
>>
>> So here are the advantages:
>>
>> * You get parsing for free (and anyone using haskell-src-exts).
>> * You get checking for free (i.e. GHC can check that IsFullError exists
>> for you).
>> * You get a continuity of documentation through your operations
>> including composition.
>> * You can extend the "documentation language" easily by just defining
>> some types (like the Throws I used above). SeeMore, Author,
>> Deprecated, etc. Whatever.
>> * You can print out some helpful looking documentation in GHCi based on
>> these simple types.
>> * There's no longer this informal "it might throw this exception" kind
>> of pros we're forced to write.
>> * It could also be used for annotations other than pure documentation,
>> including testing. E.g. add a Testable "property" and then your test
>> framework can search for functions with this Testable annotation.
>> * Free of Haddock's syntax.
>>
>> Here are the disadvantages:
>>
>> * It doesn't work for types.
>> * Writing big pros inside a string can be boring without a decent
>> editor.
>> * The neat composition trick only goes so far.
>> * There might be a compilation overhead.
>> * It would require an updated GHCi to strip them out when not wanted.
>> * Requires GHC 7.6.1+.
>>
>> Conclusions:
>>
>> What we have now for documentation is pretty good, especially generated
>> documentation. Compared to other languages Haskell is quite well
>> documented, I feel. But we can do more with it. In some languages,
>> documentation is built into the language. You can ask for documentation
>> inside the REPL, it belongs to that piece of code. It shouldn't, I don't
>> think, be left as a code comment which is essentially whitespace as far
>> as the compiler is concerned.
>>
>> Two sweet ideas that I like from the above are:
>>
>> * The checking by GHC.
>> * The extension of the "documentation language", with the ability to
>> formalize things like what exceptions are thrown.
>> * Composing functions generates "new" documentation that still makes
>> sense.
>>
>> Thoughts?
>>
>> Ciao!
>>
>> _______________________________________________
>> Haskell-Cafe mailing list
>> Haskell-Cafe at haskell.org
>> http://www.haskell.org/mailman/listinfo/haskell-cafe
>>
>>
>
> _______________________________________________
> Haskell-Cafe mailing list
> Haskell-Cafe at haskell.org
> http://www.haskell.org/mailman/listinfo/haskell-cafe
>
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://www.haskell.org/pipermail/haskell-cafe/attachments/20121227/60bdccf7/attachment.htm>
More information about the Haskell-Cafe
mailing list