diff --git a/.travis.yml b/.travis.yml --- a/.travis.yml +++ b/.travis.yml @@ -9,6 +9,10 @@ - GHCVER=8.6.4 CABALVER=2.4 - GHCVER=head CABALVER=head +cache: + directories: + - "home/travis/.cabal/" + # Allow for develop branch to break matrix: allow_failures: @@ -23,7 +27,6 @@ - export PATH=$HOME/.cabal/bin:$PATH - travis_retry cabal v2-update -# Install Happy and Alex first, before installing install: - echo $PATH - cabal --version @@ -31,4 +34,5 @@ - cabal v2-configure --enable-tests script: + - cabal v2-build - cabal v2-test diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for `pretty-ghci` +## 0.2.0.0 -- 2019-04-16 + +* Proper windows support and CI +* Add test files to tarball + ## 0.1.0.0 -- 2019-03-07 * First version. Released on an unsuspecting world. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -### `pretty-ghci` [![Build Status][0]][1] +## `pretty-ghci` [![Travis Status][0]][1] [![Appveyor Status][4]][5] [![Hackage][2]][3] This library will make your GHCi experience colourful in 3 steps: @@ -50,3 +50,7 @@ [0]: https://travis-ci.org/harpocrates/pretty-ghci.svg?branch=master [1]: https://travis-ci.org/harpocrates/pretty-ghci +[2]: https://img.shields.io/hackage/v/pretty-ghci.svg +[3]: https://hackage.haskell.org/package/pretty-ghci +[4]: https://ci.appveyor.com/api/projects/status/qnbk7jblij7skb3l/branch/master?svg=true +[5]: https://ci.appveyor.com/project/harpocrates/pretty-ghci/branch/master diff --git a/haddock-test/Main.hs b/haddock-test/Main.hs --- a/haddock-test/Main.hs +++ b/haddock-test/Main.hs @@ -57,7 +57,7 @@ then do writeFile ref output else do writeFile out output diff : _ <- catMaybes <$> traverse findExecutable ["colordiff", "diff"] - callProcess diff [ref, out] + callProcess diff ["--strip-trailing-cr", ref, out] -- Report status putStrLn $ "All " <> show (length srcs) <> " test cases " <> if accept then "accepted." else "passed." diff --git a/haddock-test/ref/sample1.txt b/haddock-test/ref/sample1.txt new file mode 100644 --- /dev/null +++ b/haddock-test/ref/sample1.txt @@ -0,0 +1,13 @@ +Hellow world this is a really [google](www.google.com) really really long +paragraph which is just not ever end \( 1 + 2 \) at allllllllllllllllll like +ever ever + + 1. bullet 1 + + 2. bullet 2 + + 3. bullet 3 + + 4. bullet 4 + +and then... diff --git a/haddock-test/ref/sample2.txt b/haddock-test/ref/sample2.txt new file mode 100644 --- /dev/null +++ b/haddock-test/ref/sample2.txt @@ -0,0 +1,70 @@ += The best section + +Hellow world this is a really really really long paragraph which is just not +ever end at allllllllllllllllll like ever ever + + * bullet 1 + + * bullet 2 which is sort of never ending like ever e ever e ever e ever e ever + e ever e ever e ever e ever e ever e ever bullet 2 which is sort of + never ending like ever e ever e ever e ever e ever e ever e ever e ever e + ever e ever e ever + + * subpoint 1 + + * subpoint 2 + + bullet 2 which is sort of never ending like ever e ever e ever e ever e ever + e ever e ever e ever e ever e ever e ever bullet 2 which is sort of never + ending like ever e ever e ever e ever e ever e ever e ever e ever e ever e + ever e ever + + * bullet 3 + + >>> f x + SomeConstructor [1,2,3] + >>> f x y z + SomeConstructor { + x = 019343298472 + y = fdsifsiudfyoisudf + } + + fib 0 = 0 + fib 1 = 1 + fib n = fib (n-1) + fib (n-2) + + or + + fib 0 = 0 + fib 1 = 1 + fib n = fib (n-1) + fib (n-2) + + * bullet 4 + +and then... + +fib 0 = 0 +fib 1 = 1 +fib n = fib (n-1) + fib (n-2) + +or + +fib 0 = 0 +fib 1 = 1 +fib n = fib (n-1) + fib (n-2) + +=== HEADER 2 + +\[ +\int_0^\infty e^{-x^2} dx +\] + +And here is an example: + +>>> f x +SomeConstructor [1,2,3] +>>> f x y z +SomeConstructor { + x = 019343298472 + y = fdsifsiudfyoisudf +} diff --git a/haddock-test/ref/sample3.txt b/haddock-test/ref/sample3.txt new file mode 100644 --- /dev/null +++ b/haddock-test/ref/sample3.txt @@ -0,0 +1,28 @@ +The Eq class defines equality (==) and inequality (/=). All the basic datatypes +exported by the Prelude are instances of Eq, and Eq may be derived for any +datatype whose constituents are also instances of Eq. + +The Haskell Report defines no laws for Eq. However, == is customarily expected +to implement an equivalence relationship where two values comparing equal are +indistinguishable by "public" functions, with a "public" function being one not +allowing to see implementation details. For example, for a type representing +non-normalised natural numbers modulo 100, a "public" function doesn't make the +difference between 1 and 201. It is expected to have the following properties: + + Reflexivity: + x == x = True + + Symmetry: + x == y = y == x + + Transitivity: + if x == y && y == z = True, then x == z = True + + Substitutivity: + if x == y = True and f is a "public" function + whose return type is an instance of Eq, then f x == f y = True + + Negation: + x /= y = not (x == y) + +Minimal complete definition: either == or /=. diff --git a/haddock-test/src/sample1.txt b/haddock-test/src/sample1.txt new file mode 100644 --- /dev/null +++ b/haddock-test/src/sample1.txt @@ -0,0 +1,8 @@ +Hellow world this is a really [google](www.google.com) really really long paragraph which is just not ever end \(1 + 2 \) at allllllllllllllllll like ever ever + + 1. bullet 1 + 2. bullet 2 + 3. bullet 3 + 4. bullet 4 + +and then... diff --git a/haddock-test/src/sample2.txt b/haddock-test/src/sample2.txt new file mode 100644 --- /dev/null +++ b/haddock-test/src/sample2.txt @@ -0,0 +1,67 @@ += The best section + +Hellow world this is a really really really long paragraph which is just not ever end at allllllllllllllllll like ever ever + + * bullet 1 + * bullet 2 which is sort of never /ending/ like ever e ever e ever e ever e ever e ever e ever e ever e ever e ever e ever + bullet 2 which is sort of never @ending like ever e ever e ever e 'ever' e ever e ever e ever e ever e ever e ever e@ ever + + - subpoint 1 + - subpoint 2 + + bullet 2 which is sort of never ending like ever e ever e ever e ever e ever e ever e ever e ever e ever e ever e ever + bullet 2 which is sort of never ending like ever e ever e ever e ever e ever e ever e ever e ever e ever e ever e ever + + * bullet 3 + + >>> f x + SomeConstructor [1,2,3] + >>> f x y z + SomeConstructor { + x = 019343298472 + y = fdsifsiudfyoisudf + } + + @ + fib 0 = 0 + fib 1 = 1 + fib n = 'fib' (n-1) + fib (n-2) + @ + + or + + > fib 0 = 0 + > fib 1 = 1 + > fib n = fib (n-1) + fib (n-2) + + * bullet 4 + +and then... + +@ +fib 0 = 0 +fib 1 = 1 +fib n = 'fib' (n-1) + fib (n-2) +@ + +or + +> fib 0 = 0 +> fib 1 = 1 +> fib n = fib (n-1) + fib (n-2) + +=== HEADER 2 + +\[ +\int_0^\infty e^{-x^2} dx +\] + +And here is an example: + +>>> f x +SomeConstructor [1,2,3] +>>> f x y z +SomeConstructor { + x = 019343298472 + y = fdsifsiudfyoisudf +} diff --git a/haddock-test/src/sample3.txt b/haddock-test/src/sample3.txt new file mode 100644 --- /dev/null +++ b/haddock-test/src/sample3.txt @@ -0,0 +1,21 @@ +The 'Eq' class defines equality ('==') and inequality ('/='). +All the basic datatypes exported by the "Prelude" are instances of 'Eq', +and 'Eq' may be derived for any datatype whose constituents are also +instances of 'Eq'. + +The Haskell Report defines no laws for 'Eq'. However, '==' is customarily +expected to implement an equivalence relationship where two values comparing +equal are indistinguishable by "public" functions, with a "public" function +being one not allowing to see implementation details. For example, for a +type representing non-normalised natural numbers modulo 100, a "public" +function doesn't make the difference between 1 and 201. It is expected to +have the following properties: + +[__Reflexivity__]: @x '==' x@ = 'True' +[__Symmetry__]: @x == y@ = @y == x@ +[__Transitivity__]: if @x == y && y == z@ = 'True', then @x == z@ = 'True' +[__Substitutivity__]: if @x == y@ = 'True' and @f@ is a "public" function +whose return type is an instance of 'Eq', then @f x == f y@ = 'True' +[__Negation__]: @x /= y@ = @not (x == y)@ + +Minimal complete definition: either '==' or '/='. diff --git a/pretty-ghci.cabal b/pretty-ghci.cabal --- a/pretty-ghci.cabal +++ b/pretty-ghci.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 name: pretty-ghci -version: 0.1.0.0 +version: 0.2.0.0 synopsis: Functionality for beautifying GHCi license: BSD3 license-file: LICENSE @@ -22,6 +22,10 @@ .gitignore CHANGELOG.md README.md + haddock-test/src/*.txt + haddock-test/ref/*.txt + show-test/src/*.txt + show-test/ref/*.txt tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.4, GHC==8.6.4 @@ -44,8 +48,8 @@ Text.PrettyPrint.GHCi.Value.Parser System.Terminal.Utils - build-tools: alex >=3.1 - , happy >=1.19 + build-tools: alex >=3.1 + , happy >=1.19 build-depends: base >=4.9 && <4.13 , haddock-library ^>=1.7 @@ -57,6 +61,12 @@ ghc-options: -Wall -Wcompat hs-source-dirs: src default-language: Haskell2010 + + if os(windows) + hs-source-dirs: src-windows + build-depends: Win32 >=2.6.2 + else + hs-source-dirs: src-unix test-suite haddock-test type: exitcode-stdio-1.0 diff --git a/show-test/Main.hs b/show-test/Main.hs --- a/show-test/Main.hs +++ b/show-test/Main.hs @@ -13,6 +13,8 @@ import System.FilePath ( (), takeFileName ) import System.Process ( callProcess ) +import GHC.IO.Encoding ( setLocaleEncoding, utf8 ) + -- | Option parser options :: [OptDescr Opt] options = [ Option [] ["accept"] (NoArg Accept) "accept the output" @@ -48,6 +50,7 @@ out = "show-test" "out" srcFile src = "show-test" "src" srcFile + setLocaleEncoding utf8 inp <- readFile src let output = renderString (layoutPretty defaultLayoutOptions (value2Doc inp)) @@ -56,7 +59,7 @@ then do writeFile ref output else do writeFile out output diff : _ <- catMaybes <$> traverse findExecutable ["colordiff", "diff"] - callProcess diff [ref, out] + callProcess diff ["--strip-trailing-cr", ref, out] -- Report status putStrLn $ "All " <> show (length srcs) <> " test cases " <> if accept then "accepted." else "passed." diff --git a/show-test/ref/error_recovery.txt b/show-test/ref/error_recovery.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/error_recovery.txt @@ -0,0 +1,4 @@ +Rec + { exotic1 = (, 1#, 1 # 3, fromList [(1, "value1"), (2, "value2")]) + , exotic2 = tag1-tag2-1.2.3 + , exotic3 = 1 :*: 2 :*: 3 :*: 4 } diff --git a/show-test/ref/lists_tuples.txt b/show-test/ref/lists_tuples.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/lists_tuples.txt @@ -0,0 +1,19 @@ +([ (112736512, [[[[[[[[[[]]]]]]]]]]) + , [2] + , ("just parens pls") + , ( ( ((((), ()), ((), ())), (((), ()), ((), ()))) + , ((((), ()), ((), ())), (((), ()), ((), ()))) ) + , ( ((((), ()), ((), ())), (((), ()), ((), ()))) + , ((((), ()), ((), ())), (((), ()), ((), ()))) ) ) + , ( [1, 2, 3, 4, 5, 6, 7, 8, 9, 10] + , ["1", "2", "3", "4", "5", "6", "7", "8", "9", "10"] + , [ [1] + , [1, 0] + , [1, 1] + , [1, 0, 0] + , [1, 0, 1] + , [1, 1, 0] + , [1, 1, 1] + , [1, 0, 0, 0] + , [1, 0, 0, 1] + , [1, 0, 1, 0] ] ) ]) diff --git a/show-test/ref/literals.txt b/show-test/ref/literals.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/literals.txt @@ -0,0 +1,4 @@ +( [0x123456789abcdefABCDEF#, -0o1234567, 123_456_789, 0b10101010111] +, [123.4324e-12398, -123112312312312323.298, 0xDeadBeef.001P99##] +, ["hello \123orld", "some \n\r\ESC escapes \x0fff", "to \"' test", "μnicode"] +, ['a', '\'', '"', '\BEL', 'μ'] ) diff --git a/show-test/ref/records.txt b/show-test/ref/records.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/records.txt @@ -0,0 +1,11 @@ +BigFactoryCabalRecord + { bfcr_hash = 0x123987 + , bfcr_name = Just "some big package" + , (+*&^) = 42 + , bfcr_version = mkVersion [0, 1, 0, 0] + , bfcr_changelog = [ SubRecord1 Nothing Nothing Nothing + , SubRecord1 + { date = Just (Date 9999) + , reason = Nothing + , compatibility = Just None } ] + , bfcr_small = Point { x = 99, y = 109 } } diff --git a/show-test/ref/sample1.txt b/show-test/ref/sample1.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/sample1.txt @@ -0,0 +1,3 @@ +( 1239187639817639817623981 +, [Just ("some looooooooooooong string", True), Nothing] +, Point { xCoord = Int, yCoord = 99 } ) diff --git a/show-test/ref/sample2.txt b/show-test/ref/sample2.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/sample2.txt @@ -0,0 +1,5 @@ +GiganticRecord + { gr_subrecord1 = SubRecord1 { foo = 98, baz = "hello", qux = 'x' } + , gr_subrecord2 = [ SubRecord2 132 (4 + 5) + , SubRecord2 29384792387 / 329387423423 ] + , gr_subrecord3 = AnotherHugeProduct 123987e98798 0x876 0b0101010 (pi, e) } diff --git a/show-test/ref/sample3.txt b/show-test/ref/sample3.txt new file mode 100644 --- /dev/null +++ b/show-test/ref/sample3.txt @@ -0,0 +1,133 @@ +MetaDoc + { _meta = Meta { _version = Nothing, _package = Nothing } + , _doc = DocAppend + (DocParagraph + (DocAppend + (DocString "The ") + (DocAppend + (DocIdentifier ('\'', "Eq", '\'')) + (DocAppend + (DocString " class defines equality (") + (DocAppend + (DocIdentifier ('\'', "==", '\'')) + (DocAppend + (DocString ") and inequality (") + (DocAppend + (DocIdentifier ('\'', "/=", '\'')) + (DocAppend + (DocString + ").\nAll the basic datatypes exported by the ") + (DocAppend + (DocModule "Prelude") + (DocAppend + (DocString " are instances of ") + (DocAppend + (DocIdentifier ('\'', "Eq", '\'')) + (DocAppend + (DocString ",\nand ") + (DocAppend + (DocIdentifier + ('\'', "Eq", '\'')) + (DocAppend + (DocString + " may be derived for any datatype whose constituents are also\ninstances of ") + (DocAppend + (DocIdentifier + ('\'', "Eq", '\'')) + (DocString + ".")))))))))))))))) + (DocAppend + (DocParagraph + (DocAppend + (DocString "The Haskell Report defines no laws for ") + (DocAppend + (DocIdentifier ('\'', "Eq", '\'')) + (DocAppend + (DocString ". However, ") + (DocAppend + (DocIdentifier ('\'', "==", '\'')) + (DocString + " is customarily\nexpected to implement an equivalence relationship where two values comparing\nequal are indistinguishable by \"public\" functions, with a \"public\" function\nbeing one not allowing to see implementation details. For example, for a\ntype representing non-normalised natural numbers modulo 100, a \"public\"\nfunction doesn't make the difference between 1 and 201. It is expected to\nhave the following properties:")))))) + (DocAppend + (DocDefList + [ ( DocBold (DocString "Reflexivity") + , DocAppend + (DocMonospaced + (DocAppend + (DocString "x ") + (DocAppend + (DocIdentifier ('\'', "==", '\'')) + (DocString " x")))) + (DocAppend + (DocString " = ") + (DocIdentifier ('\'', "True", '\''))) ) + , ( DocBold (DocString "Symmetry") + , DocAppend + (DocMonospaced (DocString "x == y")) + (DocAppend + (DocString " = ") + (DocMonospaced (DocString "y == x"))) ) + , ( DocBold (DocString "Transitivity") + , DocAppend + (DocString "if ") + (DocAppend + (DocMonospaced (DocString "x == y && y == z")) + (DocAppend + (DocString " = ") + (DocAppend + (DocIdentifier ('\'', "True", '\'')) + (DocAppend + (DocString ", then ") + (DocAppend + (DocMonospaced (DocString "x == z")) + (DocAppend + (DocString " = ") + (DocIdentifier + ('\'', "True", '\'')))))))) ) + , ( DocBold (DocString "Substitutivity") + , DocAppend + (DocString "if ") + (DocAppend + (DocMonospaced (DocString "x == y")) + (DocAppend + (DocString " = ") + (DocAppend + (DocIdentifier ('\'', "True", '\'')) + (DocAppend + (DocString " and ") + (DocAppend + (DocMonospaced (DocString "f")) + (DocAppend + (DocString + " is a \"public\" function\nwhose return type is an instance of ") + (DocAppend + (DocIdentifier + ('\'', "Eq", '\'')) + (DocAppend + (DocString ", then ") + (DocAppend + (DocMonospaced + (DocString + "f x == f y")) + (DocAppend + (DocString " = ") + (DocIdentifier + ( '\'' + , "True" + , '\'' )))))))))))) ) + , ( DocBold (DocString "Negation") + , DocAppend + (DocMonospaced (DocString "x /= y")) + (DocAppend + (DocString " = ") + (DocMonospaced (DocString "not (x == y)"))) ) ]) + (DocParagraph + (DocAppend + (DocString "Minimal complete definition: either ") + (DocAppend + (DocIdentifier ('\'', "==", '\'')) + (DocAppend + (DocString " or ") + (DocAppend + (DocIdentifier ('\'', "/=", '\'')) + (DocString ".")))))))) } diff --git a/show-test/src/error_recovery.txt b/show-test/src/error_recovery.txt new file mode 100644 --- /dev/null +++ b/show-test/src/error_recovery.txt @@ -0,0 +1,4 @@ +Rec { + exotic1 = (, 1#, 1 # 3, fromList [(1,"value1"),(2,"value2")]), + exotic2 = tag1-tag2-1.2.3, + exotic3 = 1 :*: 2 :*: 3 :*: 4 } diff --git a/show-test/src/lists_tuples.txt b/show-test/src/lists_tuples.txt new file mode 100644 --- /dev/null +++ b/show-test/src/lists_tuples.txt @@ -0,0 +1,6 @@ +([ (112736512, [[[[[[[[[[]]]]]]]]]]) +, [2] +, ("just parens pls") +, ((((((),()),((),())),(((),()),((),()))),((((),()),((),())),(((),()),((),())))),(((((),()),((),())),(((),()),((),()))),((((),()),((),())),(((),()),((),()))))) +, ([1,2,3,4,5,6,7,8,9,10],["1","2","3","4","5","6","7","8","9","10"],[[1],[1,0],[1,1],[1,0,0],[1,0,1],[1,1,0],[1,1,1],[1,0,0,0],[1,0,0,1],[1,0,1,0]]) +]) diff --git a/show-test/src/literals.txt b/show-test/src/literals.txt new file mode 100644 --- /dev/null +++ b/show-test/src/literals.txt @@ -0,0 +1,12 @@ +([0x123456789abcdefABCDEF#, + -0o1234567, + 123_456_789, + 0b10101010111], + [123.4324e-12398, + -123112312312312323.298, + 0xDeadBeef.001P99##], + ["hello \123orld", + "some \n\r\ESC escapes \x0fff", + "to \"' test", + "μnicode"], + ['a', '\'', '"', '\BEL', 'μ']) diff --git a/show-test/src/records.txt b/show-test/src/records.txt new file mode 100644 --- /dev/null +++ b/show-test/src/records.txt @@ -0,0 +1,9 @@ +BigFactoryCabalRecord { bfcr_hash = 0x123987, + bfcr_name = Just "some big package", (+*&^) = 42, + bfcr_version = mkVersion [0,1,0,0], + bfcr_changelog = [ + SubRecord1 Nothing Nothing Nothing, + SubRecord1 { date = Just (Date 9999), reason = Nothing + , compatibility = Just None } + ], + bfcr_small = Point { x = 99, y = 109 } } diff --git a/show-test/src/sample1.txt b/show-test/src/sample1.txt new file mode 100644 --- /dev/null +++ b/show-test/src/sample1.txt @@ -0,0 +1,1 @@ +( 1239187639817639817623981, [ Just ("some looooooooooooong string", True), Nothing ], Point { xCoord = Int, yCoord = 99 }) diff --git a/show-test/src/sample2.txt b/show-test/src/sample2.txt new file mode 100644 --- /dev/null +++ b/show-test/src/sample2.txt @@ -0,0 +1,5 @@ +GiganticRecord { + gr_subrecord1 = SubRecord1 { foo = 98, baz = "hello", qux = 'x' }, + gr_subrecord2 = [ SubRecord2 132 (4 + 5), SubRecord2 29384792387 / 329387423423 ], + gr_subrecord3 = AnotherHugeProduct 123987e98798 0x876 0b0101010 ( pi, e ) +} diff --git a/show-test/src/sample3.txt b/show-test/src/sample3.txt new file mode 100644 --- /dev/null +++ b/show-test/src/sample3.txt @@ -0,0 +1,1 @@ +MetaDoc {_meta = Meta {_version = Nothing, _package = Nothing}, _doc = DocAppend (DocParagraph (DocAppend (DocString "The ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocAppend (DocString " class defines equality (") (DocAppend (DocIdentifier ('\'',"==",'\'')) (DocAppend (DocString ") and inequality (") (DocAppend (DocIdentifier ('\'',"/=",'\'')) (DocAppend (DocString ").\nAll the basic datatypes exported by the ") (DocAppend (DocModule "Prelude") (DocAppend (DocString " are instances of ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocAppend (DocString ",\nand ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocAppend (DocString " may be derived for any datatype whose constituents are also\ninstances of ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocString ".")))))))))))))))) (DocAppend (DocParagraph (DocAppend (DocString "The Haskell Report defines no laws for ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocAppend (DocString ". However, ") (DocAppend (DocIdentifier ('\'',"==",'\'')) (DocString " is customarily\nexpected to implement an equivalence relationship where two values comparing\nequal are indistinguishable by \"public\" functions, with a \"public\" function\nbeing one not allowing to see implementation details. For example, for a\ntype representing non-normalised natural numbers modulo 100, a \"public\"\nfunction doesn't make the difference between 1 and 201. It is expected to\nhave the following properties:")))))) (DocAppend (DocDefList [(DocBold (DocString "Reflexivity"),DocAppend (DocMonospaced (DocAppend (DocString "x ") (DocAppend (DocIdentifier ('\'',"==",'\'')) (DocString " x")))) (DocAppend (DocString " = ") (DocIdentifier ('\'',"True",'\'')))),(DocBold (DocString "Symmetry"),DocAppend (DocMonospaced (DocString "x == y")) (DocAppend (DocString " = ") (DocMonospaced (DocString "y == x")))),(DocBold (DocString "Transitivity"),DocAppend (DocString "if ") (DocAppend (DocMonospaced (DocString "x == y && y == z")) (DocAppend (DocString " = ") (DocAppend (DocIdentifier ('\'',"True",'\'')) (DocAppend (DocString ", then ") (DocAppend (DocMonospaced (DocString "x == z")) (DocAppend (DocString " = ") (DocIdentifier ('\'',"True",'\''))))))))),(DocBold (DocString "Substitutivity"),DocAppend (DocString "if ") (DocAppend (DocMonospaced (DocString "x == y")) (DocAppend (DocString " = ") (DocAppend (DocIdentifier ('\'',"True",'\'')) (DocAppend (DocString " and ") (DocAppend (DocMonospaced (DocString "f")) (DocAppend (DocString " is a \"public\" function\nwhose return type is an instance of ") (DocAppend (DocIdentifier ('\'',"Eq",'\'')) (DocAppend (DocString ", then ") (DocAppend (DocMonospaced (DocString "f x == f y")) (DocAppend (DocString " = ") (DocIdentifier ('\'',"True",'\''))))))))))))),(DocBold (DocString "Negation"),DocAppend (DocMonospaced (DocString "x /= y")) (DocAppend (DocString " = ") (DocMonospaced (DocString "not (x == y)"))))]) (DocParagraph (DocAppend (DocString "Minimal complete definition: either ") (DocAppend (DocIdentifier ('\'',"==",'\'')) (DocAppend (DocString " or ") (DocAppend (DocIdentifier ('\'',"/=",'\'')) (DocString "."))))))))} diff --git a/src-unix/System/Terminal/Utils.hsc b/src-unix/System/Terminal/Utils.hsc new file mode 100644 --- /dev/null +++ b/src-unix/System/Terminal/Utils.hsc @@ -0,0 +1,50 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +----------------------------------------------------------------------------- +-- | +-- Module : System.Terminal.Utils +-- Copyright : Alec Theriault 2019 +-- License : BSD3 +-- +-- Maintainer : alec.theriault@gmail.com +-- Portability : portable +-- +-- Terminal-related utilities +module System.Terminal.Utils ( + getTerminalSize, +) where + +import Foreign +import Foreign.C.Types +import Foreign.Marshal.Alloc ( alloca ) + +#include +#include + +-- | Try to get the number of rows and columns respectively in the terminal +getTerminalSize :: IO (Maybe (Int,Int)) +getTerminalSize = alloca $ \ws -> do + res <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) ws + if res == -1 + then pure Nothing + else do + WinSize row col <- peek ws + pure (Just (fromIntegral row, fromIntegral col)) + +-- | @ioctl@ fills the struct at the pointer you passed in with the size info +foreign import ccall "sys/ioctl.h ioctl" + ioctl :: CInt -> CInt -> Ptr WinSize -> IO CInt + +-- | Match @struct winsize@ in @sys/ioctl.h@. +data WinSize = WinSize CUShort CUShort + +instance Storable WinSize where + sizeOf _ = (#size struct winsize) + alignment _ = (#alignment struct winsize) + peek ptr = do + row <- (#peek struct winsize, ws_row) ptr + col <- (#peek struct winsize, ws_col) ptr + pure (WinSize row col) + poke ptr (WinSize row col) = do + (#poke struct winsize, ws_row) ptr row + (#poke struct winsize, ws_col) ptr col diff --git a/src-windows/System/Terminal/Utils.hs b/src-windows/System/Terminal/Utils.hs new file mode 100644 --- /dev/null +++ b/src-windows/System/Terminal/Utils.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +----------------------------------------------------------------------------- +-- | +-- Module : System.Terminal.Utils +-- Copyright : Alec Theriault 2019 +-- License : BSD3 +-- +-- Maintainer : alec.theriault@gmail.com +-- Portability : portable +-- +-- Terminal-related utilities +module System.Terminal.Utils ( + getTerminalSize, +) where + +import Control.Exception +import System.Win32.Console + +-- | Try to get the number of rows and columns respectively in the terminal +getTerminalSize :: IO (Maybe (Int,Int)) +getTerminalSize = fmap Just rowsCols `catch` \(_ :: IOException) -> pure Nothing + where + rowsCols = do + smallRect <- srWindow <$> getCurrentConsoleScreenBufferInfo + pure ( fromIntegral (bottom smallRect - top smallRect + 1) + , fromIntegral (right smallRect - left smallRect + 1) + ) diff --git a/src/System/Terminal/Utils.hsc b/src/System/Terminal/Utils.hsc deleted file mode 100644 --- a/src/System/Terminal/Utils.hsc +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module System.Terminal.Utils ( - getTerminalSize, -) where - -import Foreign -import Foreign.C.Types -import Foreign.Marshal.Alloc ( alloca ) - - --- | Try to get the number of rows and columns respectively in the terminal -getTerminalSize :: IO (Maybe (Int,Int)) - -#if defined(WINDOWS) - -getTerminalSize = pure Nothing - -#else - -#include -#include - -getTerminalSize = alloca $ \ws -> do - res <- ioctl (#const STDOUT_FILENO) (#const TIOCGWINSZ) ws - if res == -1 - then pure Nothing - else do - WinSize row col <- peek ws - pure (Just (fromIntegral row, fromIntegral col)) - --- | @ioctl@ fills the struct at the pointer you passed in with the size info -foreign import ccall "sys/ioctl.h ioctl" - ioctl :: CInt -> CInt -> Ptr WinSize -> IO CInt - --- | Match @struct winsize@ in @sys/ioctl.h@. -data WinSize = WinSize CUShort CUShort - -instance Storable WinSize where - sizeOf _ = (#size struct winsize) - alignment _ = (#alignment struct winsize) - peek ptr = do - row <- (#peek struct winsize, ws_row) ptr - col <- (#peek struct winsize, ws_col) ptr - pure (WinSize row col) - poke ptr (WinSize row col) = do - (#poke struct winsize, ws_row) ptr row - (#poke struct winsize, ws_col) ptr col - -#endif