WEditor (empty) → 0.1.0.0
raw patch · 43 files changed
+3163/−0 lines, 43 filesdep +WEditordep +basedep +directorysetup-changed
Dependencies added: WEditor, base, directory, filepath
Files
- ChangeLog.md +5/−0
- LICENSE +202/−0
- Setup.hs +2/−0
- WEditor.cabal +96/−0
- WEditor/Base.hs +43/−0
- WEditor/Base/Char.hs +54/−0
- WEditor/Base/Editor.hs +157/−0
- WEditor/Base/Line.hs +39/−0
- WEditor/Base/Para.hs +40/−0
- WEditor/Base/Parser.hs +63/−0
- WEditor/Base/Viewer.hs +49/−0
- WEditor/Document.hs +262/−0
- WEditor/Internal/Line.hs +127/−0
- WEditor/Internal/Para.hs +278/−0
- WEditor/LineWrap.hs +209/−0
- test/Common.hs +86/−0
- test/TestDocument.hs +390/−0
- test/TestLine.hs +186/−0
- test/TestLineWrap.hs +213/−0
- test/TestPara.hs +371/−0
- test/test.hs +44/−0
- test/testfiles/below-bottom-view.txt +1/−0
- test/testfiles/below-view.txt +10/−0
- test/testfiles/break-after-view.txt +10/−0
- test/testfiles/break-before-view.txt +10/−0
- test/testfiles/default-view.txt +10/−0
- test/testfiles/delete-middle-flat.txt +13/−0
- test/testfiles/delete-middle-view.txt +10/−0
- test/testfiles/insert-back-view.txt +10/−0
- test/testfiles/insert-front-view.txt +10/−0
- test/testfiles/insert-middle-flat.txt +13/−0
- test/testfiles/insert-middle-view.txt +10/−0
- test/testfiles/join-next-view.txt +10/−0
- test/testfiles/join-prev-view.txt +10/−0
- test/testfiles/no-bound-view.txt +43/−0
- test/testfiles/no-wrap-view.txt +10/−0
- test/testfiles/original-long.txt +13/−0
- test/testfiles/original-short.txt +3/−0
- test/testfiles/page-down-view.txt +10/−0
- test/testfiles/page-up-view.txt +10/−0
- test/testfiles/resize-larger-view.txt +12/−0
- test/testfiles/resize-smaller-view.txt +9/−0
- test/testfiles/resize-truncate-view.txt +10/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for WEditor++## 0.1.0.0 -- 2020-04-14++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright 2020 Kevin P. Barry++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ WEditor.cabal view
@@ -0,0 +1,96 @@+name: WEditor+version: 0.1.0.0+synopsis: Generic text-editor logic for use with fixed-width fonts.++description:+ This package contains interfaces and implementations of text-editing idioms+ that can be wired up to UI libraries to create a text-editor widget.+ .+ The goal is to provide:+ .+ * Dynamic line wrapping that preserves the cursor and edit positions.+ * Customizable line-wrapping policies and word-hyphenation policies.+ * Automatic management of a fixed-size viewable area.+ * Support for novel character types.++homepage: https://github.com/ta0kira/wrapping-editor+license: Apache-2.0+license-file: LICENSE+author: Kevin P. Barry+maintainer: ta0kira@gmail.com+category: Text+build-type: Simple++cabal-version: 2.0+tested-with: GHC == 8.8.3++extra-source-files: ChangeLog.md+extra-source-files: test/testfiles/*.txt+++library+ exposed-modules: WEditor.Base,+ WEditor.Base.Char,+ WEditor.Base.Editor,+ WEditor.Base.Line,+ WEditor.Base.Para+ WEditor.Base.Parser,+ WEditor.Base.Viewer,+ WEditor.Document,+ WEditor.LineWrap++ other-modules: WEditor.Internal.Line,+ WEditor.Internal.Para++ build-depends: base,+ WEditor-internal++ default-language: Haskell2010+++library WEditor-internal+ exposed-modules: WEditor.Base,+ WEditor.Base.Char,+ WEditor.Base.Editor,+ WEditor.Base.Line,+ WEditor.Base.Para+ WEditor.Base.Parser,+ WEditor.Base.Viewer,+ WEditor.Document,+ WEditor.LineWrap,+ WEditor.Internal.Line,+ WEditor.Internal.Para++ other-extensions: ExistentialQuantification,+ FlexibleContexts,+ FlexibleInstances,+ FunctionalDependencies,+ MultiParamTypeClasses,+ RankNTypes,+ Safe,+ TypeFamilies++ build-depends: base >= 4.0 && < 4.14++ default-language: Haskell2010+++test-suite WEditor-test+ type: exitcode-stdio-1.0++ main-is: test.hs++ other-modules: Common,+ TestDocument,+ TestLine,+ TestLineWrap,+ TestPara++ hs-source-dirs: test++ build-depends: base,+ directory >= 1.0,+ filepath >= 1.0,+ WEditor-internal++ default-language: Haskell2010
+ WEditor/Base.hs view
@@ -0,0 +1,43 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Base module for implementing new editor functionality.++{-# LANGUAGE Safe #-}++module WEditor.Base (+ -- | Features of character sets.+ module WEditor.Base.Char,+ -- | Generic text-editing functionality.+ module WEditor.Base.Editor,+ -- | Simple representation of viewable text lines.+ module WEditor.Base.Line,+ -- | Simple representation of text paragraphs.+ module WEditor.Base.Para,+ -- | Generic line-parsing functionality.+ module WEditor.Base.Parser,+ -- | Generic editor-viewport functionality.+ module WEditor.Base.Viewer,+) where++import WEditor.Base.Char+import WEditor.Base.Editor+import WEditor.Base.Line+import WEditor.Base.Para+import WEditor.Base.Parser+import WEditor.Base.Viewer
+ WEditor/Base/Char.hs view
@@ -0,0 +1,54 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Features of character sets.++{-# LANGUAGE Safe #-}++module WEditor.Base.Char (+ HyphenChar(..),+ WhitespaceChar(..),+ WordChar(..),+) where++import Data.Char+++-- | Dealing with whitespace characters.+class WhitespaceChar c where+ -- | Predicate for identifying whitespace characters.+ defaultIsWhitespace :: c -> Bool++-- | Dealing with word characters.+class WhitespaceChar c => WordChar c where+ -- | Predicate for identifying word characters.+ defaultIsWordChar :: c -> Bool++-- | Supporting hyphenation.+class HyphenChar c where+ -- | The canonical hyphen character.+ defaultHyphen :: c++instance WhitespaceChar Char where+ defaultIsWhitespace = (== ' ')++instance WordChar Char where+ defaultIsWordChar = flip any [isAlpha,(`elem` ".'")] . flip ($)++instance HyphenChar Char where+ defaultHyphen = '-'
+ WEditor/Base/Editor.hs view
@@ -0,0 +1,157 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Generic text-editing functionality.++{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-}++module WEditor.Base.Editor (+ EditAction(..),+ EditDirection(..),+ EditorAction,+ MoveDirection(..),+ FixedFontEditor(..),+ editorAppendAction,+ editorBackspaceAction,+ editorDeleteAction,+ editorDownAction,+ editorEndAction,+ editorEnterAction,+ editorHomeAction,+ editorInsertAction,+ editorLeftAction,+ editorPageDownAction,+ editorPageUpAction,+ editorRightAction,+ editorSetPositionAction,+ editorUpAction,+) where++import WEditor.Base.Para+++-- | Generic text editor for fixed-width fonts.+class FixedFontEditor a c | a -> c where+ -- | Apply an edit action.+ editText :: a -> EditAction c -> EditDirection -> a+ -- | Break the current paragraph at the cursor.+ breakPara :: a -> EditDirection -> a+ -- | Apply a cursor movement.+ moveCursor :: a -> MoveDirection -> a+ -- | Get the (row,col) cursor position relative to the viewport.+ getCursor :: a -> (Int,Int)+ -- | Get the absolute (paragraph,char) edit position.+ --+ -- The position can be restored after cursor movements by calling+ -- 'setEditPoint'; however, calling 'editText' or 'breakPara' invalidates+ -- this position.+ getEditPoint :: a -> (Int,Int)+ -- | Set the absolute (paragraph,char) edit position.+ setEditPoint :: a -> (Int,Int) -> a+ -- | Get the number of characters in the current paragraph.+ getParaSize :: a -> Int+ -- | Get the number of paragraphs in the document.+ getParaCount :: a -> Int+ -- | Export the modified data.+ exportData :: a -> [UnparsedPara c]++-- | Actions that modify data.+data EditAction c =+ InsertText [c] | -- ^ Insert a block of characters.+ DeleteText -- ^ Delete a single character.+ deriving (Eq,Show)++-- | Modification direction, relative to the cursor.+data EditDirection =+ EditBefore | -- ^ Apply the edit before the cursor.+ EditAfter -- ^ Apply the edit after the cursor.+ deriving (Eq,Show)++-- | Actions that change the cursor position without changing data.+data MoveDirection =+ MoveUp | -- ^ Move up one line.+ MoveDown | -- ^ Move down one line.+ MovePrev | -- ^ Move backward one character.+ MoveNext | -- ^ Move forward one character.+ MoveHome | -- ^ Implementation-defined home operation.+ MoveEnd | -- ^ Implementation-defined end operation.+ MovePageUp | -- ^ Implementation-defined page-up operation.+ MovePageDown -- ^ Implementation-defined page-down operation.+ deriving (Eq,Show)++-- | Any action that updates a 'FixedFontEditor'.+type EditorAction c = forall a. FixedFontEditor a c => a -> a++-- | Action for the Backspace key.+editorBackspaceAction :: EditorAction c+editorBackspaceAction e = editText e DeleteText EditBefore++-- | Action for the Delete key.+editorDeleteAction :: EditorAction c+editorDeleteAction e = editText e DeleteText EditAfter++-- | Action for the Enter key.+editorEnterAction :: EditorAction c+editorEnterAction e = breakPara e EditBefore++-- | Action for normal character insertion.+editorAppendAction :: [c] -> EditorAction c+editorAppendAction cs e = editText e (InsertText cs) EditBefore++-- | Action to insert after the cursor.+editorInsertAction :: [c] -> EditorAction c+editorInsertAction cs e = editText e (InsertText cs) EditAfter++-- | Action to set the absolute (paragraph,char) edit position.+editorSetPositionAction :: (Int,Int) -> EditorAction c+editorSetPositionAction (p,c) e = setEditPoint e (p,c)++-- | Action for the up-arrow key.+editorUpAction :: EditorAction c+editorUpAction e = moveCursor e MoveUp++-- | Action for the down-arrow key.+editorDownAction :: EditorAction c+editorDownAction e = moveCursor e MoveDown++-- | Action for the left-arrow key.+editorLeftAction :: EditorAction c+editorLeftAction e = moveCursor e MovePrev++-- | Action for the right-arrow key.+editorRightAction :: EditorAction c+editorRightAction e = moveCursor e MoveNext++-- | Action for the Home key.+editorHomeAction :: EditorAction c+editorHomeAction e = moveCursor e MoveHome++-- | Action for the End key.+editorEndAction :: EditorAction c+editorEndAction e = moveCursor e MoveEnd++-- | Action for the PageUp key.+editorPageUpAction :: EditorAction c+editorPageUpAction e = moveCursor e MovePageUp++-- | Action for the PageDown key.+editorPageDownAction :: EditorAction c+editorPageDownAction e = moveCursor e MovePageDown
+ WEditor/Base/Line.hs view
@@ -0,0 +1,39 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Simple representation of viewable text lines.++{-# LANGUAGE Safe #-}++module WEditor.Base.Line (+ VisibleLine(..),+) where+++-- | Line meant for viewing.+data VisibleLine c b =+ VisibleLine {+ vlBreak :: b, -- ^ The type of line break for this line.+ vlText :: [c] -- ^ The complete data of the line.+ }+ deriving (Eq,Ord,Show)++-- | Break type that has a default.+class DefaultBreak b where+ -- | The default break for the break type.+ defaultBreak :: b
+ WEditor/Base/Para.hs view
@@ -0,0 +1,40 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Simple representation of text paragraphs.++{-# LANGUAGE Safe #-}++module WEditor.Base.Para (+ UnparsedPara(..),+ emptyPara,+) where++import WEditor.Base.Line+++-- | Single paragraph that has not been parsed into lines.+data UnparsedPara c =+ UnparsedPara {+ upText :: [c] -- ^ The complete and uparsed paragraph data.+ }+ deriving (Eq,Ord,Show)++-- | Create an empty paragraph.+emptyPara :: UnparsedPara c+emptyPara = UnparsedPara []
+ WEditor/Base/Parser.hs view
@@ -0,0 +1,63 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Generic line-parsing functionality.++{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE TypeFamilies #-}++module WEditor.Base.Parser (+ FixedFontParser(..),+ emptyLine,+) where++import WEditor.Base.Line+++-- | Line parser for fixed-width fonts.+class FixedFontParser a c | a -> c where+ -- | Type used to differentiate between line-break types.+ type BreakType a :: *+ -- | An acceptable fallback line-break type.+ defaultBreak :: a -> BreakType a+ -- | Change the max line width used for parsing. A width of zero must result+ -- in breakLines skipping line breaks.+ setLineWidth :: a -> Int -> a+ -- | Break the sequence into lines.+ --+ -- The following must hold for all possible inputs to a 'FixedFontParser'+ -- `p`:+ --+ -- prop> concat (map vlText (breakLines p line)) == line+ --+ -- Implement 'renderLine' and 'tweakCursor' to make visual adjustments (such+ -- as adding hyphens or indentation) if necessary.+ breakLines :: a -> [c] -> [VisibleLine c (BreakType a)]+ -- | Render the line for viewing. Implement 'tweakCursor' if 'renderLine'+ -- changes the positions of any characters on the line.+ renderLine :: a -> VisibleLine c (BreakType a) -> [c]+ -- | Adjust the horizontal cursor position.+ tweakCursor :: a -> VisibleLine c (BreakType a) -> Int -> Int+ tweakCursor _ _ = id++-- | Create an empty line.+emptyLine :: FixedFontParser a c => a -> VisibleLine c (BreakType a)+emptyLine p = VisibleLine (defaultBreak p) []
+ WEditor/Base/Viewer.hs view
@@ -0,0 +1,49 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Generic editor-viewport functionality.++{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-}++module WEditor.Base.Viewer (+ FixedFontViewer(..),+ ViewerAction,+ viewerResizeAction,+) where+++-- | Generic editor viewport for fixed-width fonts.+class FixedFontViewer a c | a -> c where+ -- | Sets the (width,height) size of the viewport. A width < 0 must disable+ -- line wrapping, and a height < 0 must disable vertical bounding.+ setViewSize :: a -> (Int,Int) -> a+ -- | Gets the (width,height) size of the viewport.+ getViewSize :: a -> (Int,Int)+ -- | Gets the visible lines in the viewport. This does not need to completely+ -- fill the viewport area, but it must not exceed it.+ getVisible :: a -> [[c]]++-- | Any action that updates a 'FixedFontViewer'.+type ViewerAction c = forall a. FixedFontViewer a c => a -> a++-- | Action to resize the viewport.+viewerResizeAction :: (Int,Int) -> ViewerAction c+viewerResizeAction s v = setViewSize v s
+ WEditor/Document.hs view
@@ -0,0 +1,262 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Generic document-editing components.++{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe #-}++module WEditor.Document (+ EditingDocument,+ editDocument,+ -- From Base >>>+ EditAction(..),+ EditDirection(..),+ EditorAction,+ FixedFontEditor(..),+ FixedFontParser,+ FixedFontViewer(..),+ MoveDirection(..),+ UnparsedPara(..),+ ViewerAction,+ editorAppendAction,+ editorBackspaceAction,+ editorDeleteAction,+ editorDownAction,+ editorEndAction,+ editorEnterAction,+ editorHomeAction,+ editorInsertAction,+ editorLeftAction,+ editorPageDownAction,+ editorPageUpAction,+ editorRightAction,+ editorSetPositionAction,+ editorUpAction,+ viewerResizeAction,+ -- <<< From Base+) where++import WEditor.Base+import WEditor.Internal.Line+import WEditor.Internal.Para+++-- | Generic document editor with a dynamic viewport.+data EditingDocument c =+ forall a. FixedFontParser a c => EditingDocument {+ edBefore :: [VisibleParaBefore c (BreakType a)], -- Reversed.+ edEditing :: EditingPara c (BreakType a),+ edAfter :: [VisibleParaAfter c (BreakType a)],+ edWidth :: Int,+ edHeight :: Int,+ edOffset :: Int,+ edLastCursor :: Int,+ edParser :: a+ }++-- | Create an editor for a document.+editDocument :: FixedFontParser a c => a -- ^ Parser used to break paragraphs into lines.+ -> [UnparsedPara c] -- ^ List of unparsed paragraphs to be edited.+ -> EditingDocument c -- ^ Document editor.+editDocument parser ps = document where+ document = EditingDocument {+ edBefore = [],+ edEditing = editPara parser first,+ edAfter = map (parseParaAfter parser) rest,+ edWidth = 0,+ edHeight = 0,+ edOffset = 0,+ edLastCursor = 0,+ edParser = parser+ }+ (first:rest) = nonempty ps+ nonempty [] = [emptyPara]+ nonempty ps = ps+++-- Private below here.++instance Show (EditingDocument c) where+ show d =+ "EditingDocument { size: " ++ show (getViewSize d) +++ ", cursor: " ++ show (getCursor d) +++ ", point: " ++ show (getEditPoint d) ++ " }"++instance FixedFontViewer (EditingDocument c) c where+ setViewSize d s@(w,h)+ | w /= edWidth d = storeCursor $ resizeHeight h $ resizeWidth w d+ | h /= edHeight d = storeCursor $ resizeHeight h d+ | otherwise = d+ getViewSize d = (edWidth d,edHeight d)+ getVisible = getVisibleLines++instance FixedFontEditor (EditingDocument c) c where+ editText da m d = storeCursor $ modifyDoc m d da+ breakPara da d = storeCursor $ insertParaSplit d da+ moveCursor da d = updateCursor $ moveDocCursor d da where+ updateCursor+ | d == MovePrev || d == MoveNext || d == MoveHome || d == MoveEnd = storeCursor+ | otherwise = applyCursor+ getCursor (EditingDocument _ e _ _ h k _ p) =+ (tweakCursor p (getCurrentLine e) $ getParaCursorChar e,boundOffset h k)+ getEditPoint = getDocEditPoint+ setEditPoint da (p,c) = storeCursor $ setDocEditPoint (p,c) da+ getParaSize (EditingDocument _ e _ _ _ _ _ _) = getParaCharCount e+ getParaCount da@(EditingDocument bs _ as _ _ _ _ _) = 1 + length bs + length as+ exportData = exportDocument++exportDocument :: EditingDocument c -> [UnparsedPara c]+exportDocument (EditingDocument bs e as _ _ _ _ _) =+ reverse (map unparseParaBefore bs) ++ [unparsePara e] ++ (map unparseParaAfter as)++boundOffset :: Int -> Int -> Int+boundOffset h k+ | h < 1 = max 0 k+ | otherwise = max 0 (min (h-1) k)++storeCursor :: EditingDocument c -> EditingDocument c+storeCursor (EditingDocument bs e as w h k _ p) =+ EditingDocument bs e as w h k (getParaCursorChar e) p++applyCursor :: EditingDocument c -> EditingDocument c+applyCursor (EditingDocument bs e as w h k c p) =+ EditingDocument bs (setParaCursorChar c e) as w h k c p++joinParaNext :: EditingDocument c -> EditingDocument c+joinParaNext da@(EditingDocument _ _ [] _ _ _ _ _) = da+joinParaNext (EditingDocument bs e (a:as) w h k c p) =+ EditingDocument bs (appendToPara p e a) as w h k c p++joinParaPrev :: EditingDocument c -> EditingDocument c+joinParaPrev da@(EditingDocument [] _ _ _ _ _ _ _) = da+joinParaPrev (EditingDocument (b:bs) e as w h k c p) =+ EditingDocument bs (prependToPara p b e) as w h (boundOffset h (k-1)) c p++resizeWidth :: Int -> EditingDocument c -> EditingDocument c+resizeWidth w (EditingDocument bs e as _ h k c p) = (EditingDocument bs2 e2 as2 w h k c p2) where+ p2 = setLineWidth p w+ bs2 = map (parseParaBefore p2 . unparseParaBefore) bs+ as2 = map (parseParaAfter p2 . unparseParaAfter) as+ e2 = reparsePara p2 e++resizeHeight :: Int -> EditingDocument c -> EditingDocument c+resizeHeight h da@(EditingDocument bs e as w _ k c p) =+ (EditingDocument bs e as w h offset c p) where+ offset+ | h < 1 = countLinesAbove da+ | otherwise = boundOffset h $ min (countLinesAbove da) k++countLinesAbove :: EditingDocument c -> Int+countLinesAbove (EditingDocument bs e _ _ _ _ _ _) = total where+ total = countLinesBefore bs'+ bs' = getBeforeLines e:bs++getVisibleLines :: EditingDocument c -> [[c]]+getVisibleLines (EditingDocument bs e as _ h k _ p) = visible where+ visible = map (renderLine p) $ bs2 ++ [e2] ++ as2+ bs2 = takeLinesBefore getBefore before+ e2 = getCurrentLine e+ as2 = takeLinesAfter getAfter after+ before = getBeforeLines e:bs+ after = getAfterLines e:as+ getBefore+ | h < 1 = countLinesBefore before+ | otherwise = boundOffset h k+ getAfter+ | h < 1 = countLinesAfter after+ | otherwise = h-length bs2-1++moveDocCursor :: MoveDirection -> EditingDocument c -> EditingDocument c+moveDocCursor d da@(EditingDocument bs e as w h k c p) = revised where+ revised+ | paraCursorMovable d e =+ let e2 = moveParaCursor d e in (EditingDocument bs e2 as w h (fixOffset e2) c p)+ | d == MoveDown && null as && atParaBack e =+ EditingDocument bs e as w h (boundOffset h (k-1)) c p+ | (d == MoveUp && null bs) || (d == MoveDown && null as) =+ -- NOTE: The cursor is explicitly stored here so that the position at the+ -- front or back of the paragraph is preserved.+ let e2 = moveParaCursor d e in storeCursor $ (EditingDocument bs e2 as w h (fixOffset e2) c p)+ | d == MoveUp =+ let+ bs2 = tail bs+ e2 = seekParaBack $ editPara p $ unparseParaBefore $ head bs+ as2 = viewParaAfter e:as+ k2 = boundOffset h (k-1) in+ -- NOTE: This doesn't preserve cursor position.+ EditingDocument bs2 e2 as2 w h k2 c p+ | d == MoveDown =+ let+ bs2 = viewParaBefore e:bs+ e2 = editPara p $ unparseParaAfter $ head as+ as2 = tail as+ k2 = boundOffset h (k+1) in+ -- NOTE: This doesn't preserve cursor position.+ EditingDocument bs2 e2 as2 w h k2 c p+ | d == MovePrev && not (null bs) = seekBack $ moveDocCursor MoveUp da+ | d == MoveNext && not (null as) = seekFront $ moveDocCursor MoveDown da+ | d == MovePageUp = editAtTop $ repeatTimes h (moveDocCursor MoveUp) da+ | d == MovePageDown = editAtTop $ repeatTimes h (moveDocCursor MoveDown) da+ | otherwise = da+ fixOffset e2 = boundOffset h $ k + (getParaCursorLine e2 - getParaCursorLine e)+ seekBack (EditingDocument bs e as w h k c p) = EditingDocument bs (seekParaBack e) as w h k c p+ seekFront (EditingDocument bs e as w h k c p) = EditingDocument bs (seekParaFront e) as w h k c p+ repeatTimes n = foldr (flip (.)) id . replicate n+ editAtTop (EditingDocument bs e as w h _ c p) = EditingDocument bs e as w h 0 c p++modifyDoc :: EditAction c -> EditDirection -> EditingDocument c -> EditingDocument c+modifyDoc m d da@(EditingDocument bs e as w h k c p) = revised m d where+ revised DeleteText EditBefore+ | atParaFront e && not (null bs) =+ EditingDocument (tail bs) (prependToPara p (head bs) e) as w h (boundOffset h (k-1)) c p+ revised DeleteText EditAfter+ | atParaBack e && not (null as) =+ EditingDocument bs (appendToPara p e (head as)) (tail as) w h k c p+ revised _ _ = let e2 = (modifyPara p m d e) in EditingDocument bs e2 as w h (fixOffset e2) c p+ fixOffset e2 = boundOffset h $ k + (getParaCursorLine e2 - getParaCursorLine e)++insertParaSplit :: EditDirection -> EditingDocument c -> EditingDocument c+insertParaSplit d (EditingDocument bs e as w h k c p) = revised where+ (b,a) = splitPara p e+ revised+ | d == EditBefore = EditingDocument (parseParaBefore p b:bs) (editPara p a) as w h (boundOffset h (k+1)) c p+ | d == EditAfter = EditingDocument bs (seekParaBack $ editPara p b) (parseParaAfter p a:as) w h k c p++getDocEditPoint :: EditingDocument c -> (Int,Int)+getDocEditPoint (EditingDocument bs e _ _ _ _ _ _) = (length bs,getParaEditChar e)++setEditPara :: Int -> EditingDocument c -> EditingDocument c+setEditPara n (EditingDocument bs e as w h k c p) = revised where+ revised = resizeHeight h $ EditingDocument bs2 e2 as2 w h k c p+ (bs2,e2,as2) = shift bs e as+ shift bs e as+ | length bs < n && not (null as) =+ shift (viewParaBefore e:bs) (editPara p $ unparseParaAfter $ head as) (tail as)+ | length bs > n && not (null bs) =+ shift (tail bs) (editPara p $ unparseParaBefore $ head bs) (viewParaAfter e:as)+ | otherwise = (bs,e,as)++setEditChar :: Int -> EditingDocument c -> EditingDocument c+setEditChar n (EditingDocument bs e as w h k c p) = EditingDocument bs (setParaEditChar n e) as w h k c p++setDocEditPoint :: (Int,Int) -> EditingDocument c -> EditingDocument c+setDocEditPoint (p,c) = setEditChar c . setEditPara p
+ WEditor/Internal/Line.hs view
@@ -0,0 +1,127 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | This module is for internal use.++{-# LANGUAGE Safe #-}++module WEditor.Internal.Line (+ EditingLine,+ appendToLine,+ atLineBack,+ atLineFront,+ editLine,+ getLineCursor,+ joinLines,+ lineCursorMovable,+ modifyLine,+ moveLineCursor,+ prependToLine,+ setLineCursor,+ splitLine,+ viewLine,+) where++import WEditor.Base.Editor+import WEditor.Base.Line+++data EditingLine c b =+ EditingLine {+ elTextBefore :: [c], -- Reversed.+ elTextAfter :: [c],+ elBreak :: b+ }+ deriving (Eq,Show)++editLine :: VisibleLine c b -> EditingLine c b+editLine (VisibleLine b cs) = EditingLine [] cs b++viewLine :: EditingLine c b -> VisibleLine c b+viewLine (EditingLine bs as b) = VisibleLine b (reverse bs ++ as)++joinLines :: [VisibleLine c b] -> [c]+joinLines = concat . map vlText++getLineCursor :: EditingLine c b -> Int+getLineCursor = length . elTextBefore++setLineCursor :: Int -> EditingLine c b -> EditingLine c b+setLineCursor k e@(EditingLine bs as b) = EditingLine bs2 as2 b where+ (bs2,as2) = seek (length bs) bs as+ seek n bs as+ | k < n && not (null bs) = seek (n-1) (tail bs) (head bs:as)+ | k > n && not (null as) = seek (n+1) (head as:bs) (tail as)+ | otherwise = (bs,as)++splitLine :: b -> EditingLine c b -> (VisibleLine c b,VisibleLine c b)+splitLine b0 (EditingLine bs as b) =+ (VisibleLine b0 (reverse bs),+ VisibleLine b as)++lineCursorMovable :: MoveDirection -> EditingLine c b -> Bool+lineCursorMovable MovePrev (EditingLine (_:_) _ _) = True+lineCursorMovable MoveNext (EditingLine _ (_:_) _) = True+lineCursorMovable MoveHome _ = True+lineCursorMovable MoveEnd _ = True+lineCursorMovable _ _ = False++moveLineCursor :: MoveDirection -> EditingLine c b -> EditingLine c b+moveLineCursor MoveHome p = moveLineCursor MoveUp p+moveLineCursor MoveEnd p = moveLineCursor MoveDown p+moveLineCursor MoveUp (EditingLine bs as b) =+ (EditingLine [] (reverse bs ++ as) b)+moveLineCursor MoveDown (EditingLine bs as b) =+ (EditingLine (reverse as ++ bs) [] b)+moveLineCursor MovePrev (EditingLine bs as b)+ | not (null bs) = (EditingLine (tail bs) (head bs:as) b)+moveLineCursor MoveNext (EditingLine bs as b)+ | not (null as) = (EditingLine (head as:bs) (tail as) b)+moveLineCursor _ l = l++atLineFront :: EditingLine c b -> Bool+atLineFront = null . elTextBefore++atLineBack :: EditingLine c b -> Bool+atLineBack = null . elTextAfter++appendToLine :: EditingLine c b -> VisibleLine c b -> EditingLine c b+appendToLine (EditingLine bs as c) (VisibleLine b cs) =+ (EditingLine bs (as ++ cs) b)++prependToLine :: VisibleLine c b -> EditingLine c b -> EditingLine c b+prependToLine (VisibleLine _ cs) (EditingLine bs as b) =+ (EditingLine (bs ++ reverse cs) as b)++modifyLine :: EditAction c -> EditDirection -> EditingLine c b -> EditingLine c b+modifyLine (InsertText cs) d (EditingLine bs as b) = revised where+ bs2 = if d == EditBefore+ then reverse cs ++ bs+ else bs+ as2 = if d == EditAfter+ then cs ++ as+ else as+ revised = EditingLine bs2 as2 b+modifyLine DeleteText d (EditingLine bs as b) = revised where+ bs2 = if d == EditBefore && not (null bs)+ then tail bs+ else bs+ as2 = if d == EditAfter && not (null as)+ then tail as+ else as+ revised = EditingLine bs2 as2 b
+ WEditor/Internal/Para.hs view
@@ -0,0 +1,278 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | This module is for internal use.++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-}++module WEditor.Internal.Para (+ EditingPara,+ VisibleParaAfter,+ VisibleParaBefore,+ appendToPara,+ atParaBack,+ atParaFront,+ countLinesAfter,+ countLinesBefore,+ editPara,+ getAfterLines,+ getBeforeLines,+ getCurrentLine,+ getParaCharCount,+ getParaCursorChar,+ getParaCursorLine,+ getParaEditChar,+ modifyPara,+ moveParaCursor,+ paraCursorMovable,+ parseParaAfter,+ parseParaBefore,+ prependToPara,+ reparsePara,+ seekParaBack,+ seekParaFront,+ setParaCursorChar,+ setParaEditChar,+ splitPara,+ takeLinesAfter,+ takeLinesBefore,+ unparsePara,+ unparseParaAfter,+ unparseParaBefore,+ viewAfterLines,+ viewBeforeLines,+ viewParaAfter,+ viewParaBefore,+) where++import WEditor.Base.Editor+import WEditor.Base.Line+import WEditor.Base.Para+import WEditor.Base.Parser+import WEditor.Internal.Line+++data VisibleParaBefore c b =+ VisibleParaBefore {+ vpbLines :: [VisibleLine c b], -- Reversed.+ vpbSize :: Int+ }+ deriving (Show)++data VisibleParaAfter c b =+ VisibleParaAfter {+ vpaLines :: [VisibleLine c b]+ }+ deriving (Show)++data EditingPara c b =+ EditingPara {+ epBefore :: [VisibleLine c b], -- Reversed.+ epEditing :: EditingLine c b,+ epAfter :: [VisibleLine c b],+ epSizeBefore :: Int+ }+ deriving (Show)++viewBeforeLines :: VisibleParaBefore c b -> [VisibleLine c b]+viewBeforeLines = reverse . vpbLines++viewAfterLines :: VisibleParaAfter c b -> [VisibleLine c b]+viewAfterLines = vpaLines++visibleParaBefore :: [VisibleLine c b] -> VisibleParaBefore c b+visibleParaBefore ls = VisibleParaBefore ls (sum $ map (length . vlText) ls)++parseParaBefore :: FixedFontParser a c => a -> UnparsedPara c -> VisibleParaBefore c (BreakType a)+parseParaBefore parser (UnparsedPara cs) =+ VisibleParaBefore (reverse $ breakLines parser cs) (length cs)++parseParaAfter :: FixedFontParser a c => a -> UnparsedPara c -> VisibleParaAfter c (BreakType a)+parseParaAfter parser (UnparsedPara cs) = VisibleParaAfter $ breakLines parser cs++unparseParaBefore :: VisibleParaBefore c b -> UnparsedPara c+unparseParaBefore (VisibleParaBefore ls _) = UnparsedPara $ joinLines $ reverse ls++unparseParaAfter :: VisibleParaAfter c b -> UnparsedPara c+unparseParaAfter (VisibleParaAfter ls) = UnparsedPara $ joinLines ls++editPara :: FixedFontParser a c => a -> UnparsedPara c -> EditingPara c (BreakType a)+editPara parser (UnparsedPara cs) = EditingPara [] (editLine line) after 0 where+ (line:after) = nonempty $ breakLines parser cs+ nonempty [] = [emptyLine parser]+ nonempty ls = ls++unparsePara :: EditingPara c b -> UnparsedPara c+unparsePara (EditingPara bs l as _) = UnparsedPara $ joinLines ls where+ ls = reverse bs ++ [viewLine l] ++ as++reparsePara :: FixedFontParser a c =>+ a -> EditingPara c (BreakType a) -> EditingPara c (BreakType a)+reparsePara parser (EditingPara bs l as n) = reparseParaTail parser revised where+ revised = EditingPara bs2 l2 as (sum $ map (length . vlText) bs2)+ bs' = reverse $ breakLines parser $ joinLines (reverse bs)+ (l2,bs2)+ | null bs' = (l,[])+ | otherwise = (head bs' `prependToLine` l,tail bs')++viewParaBefore :: EditingPara c b -> VisibleParaBefore c b+viewParaBefore (EditingPara bs l as _) = visibleParaBefore ls where+ ls = reverse as ++ [viewLine l] ++ bs++viewParaAfter :: EditingPara c b -> VisibleParaAfter c b+viewParaAfter (EditingPara bs l as _) = VisibleParaAfter ls where+ ls = reverse bs ++ [viewLine l] ++ as++getBeforeLines :: EditingPara c b -> VisibleParaBefore c b+getBeforeLines = visibleParaBefore . epBefore++getCurrentLine :: EditingPara c b -> VisibleLine c b+getCurrentLine = viewLine . epEditing++getAfterLines :: EditingPara c b -> VisibleParaAfter c b+getAfterLines = VisibleParaAfter . epAfter++takeLinesBefore :: Int -> [VisibleParaBefore c b] -> [VisibleLine c b]+takeLinesBefore n = reverse . take n . concat . map vpbLines++takeLinesAfter :: Int -> [VisibleParaAfter c b] -> [VisibleLine c b]+takeLinesAfter n = take n . concat . map vpaLines++countLinesBefore :: [VisibleParaBefore c b] -> Int+countLinesBefore = length . concat . map vpbLines++countLinesAfter :: [VisibleParaAfter c b] -> Int+countLinesAfter = length . concat . map vpaLines++getParaCursorLine :: EditingPara c b -> Int+getParaCursorLine = length . epBefore++getParaCursorChar :: EditingPara c b -> Int+getParaCursorChar = getLineCursor . epEditing++setParaCursorChar :: Int -> EditingPara c b -> EditingPara c b+setParaCursorChar k e@(EditingPara bs l as n) = (EditingPara bs (setLineCursor k l) as n)++getParaCharCount :: EditingPara c b -> Int+getParaCharCount = length . upText . unparsePara++getParaEditChar :: EditingPara c b -> Int+getParaEditChar (EditingPara _ l _ n) = n + getLineCursor l++setParaEditChar :: Int -> EditingPara c b -> EditingPara c b+setParaEditChar k p+ | getParaEditChar p > k && not (atParaFront p) = setParaEditChar k $ moveParaCursor MovePrev p+ | getParaEditChar p < k && not (atParaBack p) = setParaEditChar k $ moveParaCursor MoveNext p+ | otherwise = p++splitPara :: FixedFontParser a c => a -> EditingPara c (BreakType a) -> (UnparsedPara c,UnparsedPara c)+splitPara parser (EditingPara bs l as _) = let (b,a) = splitLine (defaultBreak parser) l in+ (unparseParaBefore $ VisibleParaBefore (b:bs) 0,+ unparseParaAfter $ VisibleParaAfter (a:as))++paraCursorMovable :: MoveDirection -> EditingPara c b -> Bool+paraCursorMovable d+ | d == MoveUp = not . atParaTop+ | d == MoveDown = not . atParaBottom+ | d == MovePrev = not . atParaFront+ | d == MoveNext = not . atParaBack+ | d == MoveHome || d == MoveEnd = const True+ | otherwise = const False++moveParaCursor :: MoveDirection -> EditingPara c b -> EditingPara c b+moveParaCursor d p@(EditingPara bs l as n) = revised where+ revised+ | d == MoveHome || d == MoveEnd = EditingPara bs (moveLineCursor d l) as n+ | d == MoveUp && atParaTop p = EditingPara bs (moveLineCursor MoveUp l) as n+ | d == MoveDown && atParaBottom p = EditingPara bs (moveLineCursor MoveDown l) as n+ | not (paraCursorMovable d p) = p+ | d == MoveUp =+ setParaCursorChar (getLineCursor l) $+ EditingPara (tail bs) (editLine $ head bs) (viewLine l:as) (n-length (vlText $ head bs))+ | d == MoveDown =+ setParaCursorChar (getLineCursor l) $+ EditingPara (viewLine l:bs) (editLine $ head as) (tail as) (n+length (vlText $ viewLine l))+ | lineCursorMovable d l = EditingPara bs (moveLineCursor d l) as n+ | d == MovePrev = setBack $ moveParaCursor MoveUp p+ | d == MoveNext = setFront $ moveParaCursor MoveDown p+ setBack (EditingPara bs l as n) = (EditingPara bs (moveLineCursor MoveDown l) as n)+ setFront (EditingPara bs l as n) = (EditingPara bs (moveLineCursor MoveUp l) as n)++atParaFront :: EditingPara c b -> Bool+atParaFront p@(EditingPara _ l _ _) = atParaTop p && atLineFront l++atParaBack :: EditingPara c b -> Bool+atParaBack p@(EditingPara _ l _ _) = atParaBottom p && atLineBack l++seekParaFront :: EditingPara c b -> EditingPara c b+seekParaFront p+ | atParaFront p = p+ | otherwise = seekParaFront $ moveParaCursor MoveUp p++seekParaBack :: EditingPara c b -> EditingPara c b+seekParaBack p+ | atParaBack p = p+ | otherwise = seekParaBack $ moveParaCursor MoveDown p++appendToPara :: FixedFontParser a c+ => a -> EditingPara c (BreakType a) -> VisibleParaAfter c (BreakType a) -> EditingPara c (BreakType a)+appendToPara parser (EditingPara bs l as n) (VisibleParaAfter cs) = reparseParaTail parser revised where+ revised = EditingPara bs l (as ++ cs) n++prependToPara :: FixedFontParser a c+ => a -> VisibleParaBefore c (BreakType a) -> EditingPara c (BreakType a) -> EditingPara c (BreakType a)+prependToPara parser (VisibleParaBefore cs _) (EditingPara bs l as _) = reparseParaTail parser revised where+ revised = EditingPara bs2 l2 as n2+ (VisibleParaBefore bs' n') = parseParaBefore parser $ unparseParaBefore $ visibleParaBefore (bs ++ cs)+ (l2,bs2,n2) = if null bs'+ then (l,[],0)+ else (head bs' `prependToLine` l,tail bs',n'-length (vlText $ head bs'))++modifyPara :: FixedFontParser a c+ => a -> EditAction c -> EditDirection -> EditingPara c (BreakType a) -> EditingPara c (BreakType a)+modifyPara parser m d p = reparseParaTail parser revised where+ (EditingPara bs l as n) = mergeForEdit p+ revised = EditingPara bs (modifyLine m d l) as n+++-- Private below here.++reparseParaTail :: FixedFontParser a c+ => a -> EditingPara c (BreakType a) -> EditingPara c (BreakType a)+reparseParaTail parser p@(EditingPara bs l as n) = setParaEditChar offset revised where+ offset = getParaEditChar p+ revised = EditingPara bs (editLine line) after n+ (line:after) = breakLines parser $ joinLines (viewLine l:as)++mergeForEdit :: EditingPara c b -> EditingPara c b+mergeForEdit (EditingPara bs l as n) = EditingPara bs2 l2 as2 n2 where+ l2 = addAfter as $ addBefore bs l where+ addAfter (v:_) l = l `appendToLine` v+ addAfter _ l = l+ addBefore (v:_) l = v `prependToLine` l+ addBefore _ l = l+ bs2 = if null bs then [] else tail bs+ as2 = if null as then [] else tail as+ n2 = n - (if null bs then 0 else length (vlText $ head bs))++atParaTop :: EditingPara c b -> Bool+atParaTop (EditingPara bs _ _ _) = null bs++atParaBottom :: EditingPara c b -> Bool+atParaBottom (EditingPara _ _ as _) = null as
+ WEditor/LineWrap.hs view
@@ -0,0 +1,209 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++-- | Line-wrapping implementations. (See 'FixedFontParser' for custom wrapping.)++{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE TypeFamilies #-}++module WEditor.LineWrap (+ BreakWords,+ LineBreak,+ WordSplitter(..),+ breakExact,+ breakWords,+ lazyHyphen,+ lineBreakEnd,+ lineBreakHyphen,+ lineBreakSimple,+ noHyphen,+) where++import Control.Applicative ((<|>))+import Control.Monad (when)++import WEditor.Base+++-- | Line break type for a single paragraph line.+data LineBreak = ParagraphEnd | SimpleBreak | HyphenatedWord deriving (Eq,Ord)++-- | The line is at the end of the paragraph.+lineBreakEnd :: LineBreak+lineBreakEnd = ParagraphEnd++-- | The line is nothing special.+lineBreakSimple :: LineBreak+lineBreakSimple = SimpleBreak++-- | The line ends with a hyphenated word.+lineBreakHyphen :: LineBreak+lineBreakHyphen = HyphenatedWord++data NoSplit c = NoSplit deriving (Show)++-- | Wrapping policy that breaks at exactly the viewer width.+breakExact :: BreakWords c+breakExact = breakWords NoSplit++instance WordSplitter (NoSplit c) c++-- | Word-splitting operations for use with 'BreakWords'.+class WordSplitter a c | a -> c where+ -- | Determine where to break a word.+ --+ -- * The splitter can refuse to process the word by returning 'Nothing'.+ -- * The segment sizes must provide space for a hyphen if 'appendHyphen'+ -- extends the line.+ -- * Once the word has been split up by 'BreakWords', the segments are+ -- processed as follows:+ --+ -- 1. The last segment is prepended to the next line to be parsed. This+ -- means that if the word is not split, it gets deferred to the+ -- next line.+ -- 2. If there are more segments, the first is appended to the current+ -- line being parsed.+ -- 3. All remaining segments are put on separate lines between the+ -- current and next lines.+ splitWord :: a+ -> Int -- ^ Space available on the first line.+ -> Int -- ^ Space available on new lines.+ -> [c] -- ^ The word to break.+ -> Maybe [Int] -- ^ List of segment sizes.+ splitWord _ _ _ _ = Nothing+ -- | Predicate for characters that should be treated as a part of a word.+ isWordChar :: a -> c -> Bool+ isWordChar _ _ = False+ -- | Predicate for detecting whitespace between words.+ isWhitespace :: a -> c -> Bool+ isWhitespace _ _ = False+ -- | Append the canonical hyphen character to show word breaks.+ appendHyphen :: a -> [c] -> [c]+ appendHyphen _ = id++-- | Wrapping policy that breaks lines based on words. Use 'breakWords' to+-- construct a new value.+data BreakWords c = forall a. (Show a, WordSplitter a c) => BreakWords Int a++-- | Wrapping policy that breaks lines based on words.+breakWords :: (Show a, WordSplitter a c) => a -> BreakWords c+breakWords = BreakWords 0++data NoHyphen c = NoHyphen deriving (Show)++-- | Avoids splitting words unless they are longer than a single line.+noHyphen :: WordChar c => NoHyphen c+noHyphen = NoHyphen++data LazyHyphen c = LazyHyphen deriving (Show)++-- | Hyphenates words using simple aesthetics, without dictionary awareness.+lazyHyphen :: (WordChar c, HyphenChar c) => LazyHyphen c+lazyHyphen = LazyHyphen+++-- Private below here.++instance Show LineBreak where+ show ParagraphEnd = "lineBreakEnd"+ show SimpleBreak = "lineBreakSimple"+ show HyphenatedWord = "lineBreakHyphen"++instance Show (BreakWords c) where+ show (BreakWords w s) =+ "breakWords { width: " ++ show w +++ ", split: " ++ show s ++ " }"++instance WordChar c => WordSplitter (NoHyphen c) c where+ splitWord _ k w _ = if k < w then Just [] else Nothing+ isWordChar _ = defaultIsWordChar+ isWhitespace _ = defaultIsWhitespace++instance (WordChar c, HyphenChar c) => WordSplitter (LazyHyphen c) c where+ splitWord _ k w cs+ | w < 4 || k > w = Nothing+ | k >= length cs || k < 3 = Just []+ | otherwise = Just $ (k-1):(replicate count size) where+ size = w-1+ remainder = length cs-(k-1)+ -- Uses remainder-2 because the last line needs no hyphen. This is the+ -- same as iteratively breaking off w-1 until the remainder is < w+1.+ count = (remainder-2) `div` size+ isWordChar _ = defaultIsWordChar+ isWhitespace _ = defaultIsWhitespace+ appendHyphen _ = (++[defaultHyphen])++instance FixedFontParser (BreakWords c) c where+ type BreakType (BreakWords c) = LineBreak+ defaultBreak _ = lineBreakEnd+ setLineWidth (BreakWords _ s) w = BreakWords w s+ breakLines (BreakWords w s) = breakAllLines w s+ renderLine (BreakWords w _) (VisibleLine ParagraphEnd cs)+ | w < 1 = cs+ | otherwise = take w cs+ renderLine (BreakWords _ s) (VisibleLine SimpleBreak cs) =+ reverse $ dropWhile (isWhitespace s) $ reverse cs+ renderLine (BreakWords _ s) (VisibleLine HyphenatedWord cs) = appendHyphen s cs+ tweakCursor (BreakWords w _) (VisibleLine ParagraphEnd _)+ | w < 1 = id+ | otherwise = min w+ tweakCursor (BreakWords _ s) (VisibleLine SimpleBreak cs) = max 0 . min (total-post) where+ post = length $ takeWhile (isWhitespace s) $ reverse cs+ total = length cs+ tweakCursor _ (VisibleLine HyphenatedWord cs) = id++breakAllLines :: WordSplitter a c => Int -> a -> [c] -> [VisibleLine c LineBreak]+breakAllLines _ _ [] = [VisibleLine lineBreakEnd []]+breakAllLines w s cs+ | w < 1 = [VisibleLine lineBreakEnd cs]+ | otherwise = breakOrEmpty cs where+ breakOrEmpty cs = let (Just ls) = handleSplit (reverse $ take w cs) (drop w cs) in ls+ handleSplit line rest =+ tryWord line rest <|>+ trySpaces line rest <|>+ lineDefault line rest+ lineDefault [] _ = Just []+ lineDefault ls [] = Just [VisibleLine lineBreakEnd (reverse ls)]+ lineDefault ls rs = Just $ VisibleLine lineBreakSimple (reverse ls):(breakOrEmpty rs)+ tryWord ls@(l:_) rs@(r:_) | isWordChar s l && isWordChar s r = newLines where+ newLines = do+ breaks <- splitWord s (length wordFront) w word+ -- Safety fallback for misbehaving splitters.+ when (null breaks && length wordFront == w) Nothing+ return $ case breaks of+ [] -> VisibleLine lineBreakSimple (reverse ls2):(breakOrEmpty (word ++ rs2))+ (b:bs) -> VisibleLine lineBreakHyphen (reverse ls2 ++ take b word):(hyphenate (drop b word) bs)+ ls2 = dropWhile (isWordChar s) ls+ rs2 = dropWhile (isWordChar s) rs+ wordFront = reverse $ takeWhile (isWordChar s) ls+ wordBack = takeWhile (isWordChar s) rs+ word = wordFront ++ wordBack+ hyphenate word bs | null word || null bs = breakOrEmpty (word ++ rs2)+ hyphenate word (b:bs) = (VisibleLine lineBreakHyphen (take b word)):(hyphenate (drop b word) bs)+ tryWord _ _ = Nothing+ trySpaces ls rs@(r:_) | isWhitespace s r = newLines where+ ls' = reverse ls ++ takeWhile (isWhitespace s) rs+ rs' = dropWhile (isWhitespace s) rs+ newLines+ | null rs' = Just [VisibleLine lineBreakEnd ls']+ | otherwise = Just $ (VisibleLine lineBreakSimple ls'):(breakOrEmpty rs')+ trySpaces _ _ = Nothing
+ test/Common.hs view
@@ -0,0 +1,86 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe #-}++module Common (+ checkCondition,+ checkConditions,+ composeActions,+ endLine,+ hyphenLine,+ innerLine,+ repeatAction,+ runTests,+ testFail,+ testPass,+) where++import Control.Applicative ((<|>))+import Control.Monad (when)+import Data.Maybe (catMaybes)+import System.IO (hPutStr,hPutStrLn,stderr)++import WEditor.Base+import WEditor.LineWrap+++endLine :: String -> VisibleLine Char LineBreak+endLine = VisibleLine lineBreakEnd++innerLine :: String -> VisibleLine Char LineBreak+innerLine = VisibleLine lineBreakSimple++hyphenLine :: String -> VisibleLine Char LineBreak+hyphenLine = VisibleLine lineBreakHyphen++composeActions :: [a -> a] -> a -> a+composeActions = foldr (flip (.)) id++repeatAction :: Int -> (a -> a) -> a -> a+repeatAction n f = composeActions (replicate n f)++checkConditions :: [(String,Bool)] -> IO (Maybe String)+checkConditions = fmap (foldr (<|>) Nothing) . sequence . map (uncurry checkCondition)++checkCondition :: String -> Bool -> IO (Maybe String)+checkCondition _ True = testPass+checkCondition m False = testFail m++testPass :: IO (Maybe String)+testPass = return Nothing++testFail :: String -> IO (Maybe String)+testFail m = return (Just m)++runTests :: String -> [(String,IO (Maybe String))] -> IO Int+runTests setName tests = do+ results <- fmap catMaybes $ sequence $ map runTest $ zip [1..] tests+ hPutStrLn stderr $ resultSummary results+ when (not $ null results) $ hPutStr stderr $ unlines results+ return (length results)+ where+ resultSummary rs = "*** " ++ setName ++ ": " +++ show (length tests - length rs) ++ " passed, " +++ show (length rs) ++ " failed ***"+ runTest (n,(name,test)) = do+ result <- test+ case result of+ Just m -> return (Just $ "Test " ++ show n ++ " (" ++ name ++ "): " ++ m)+ Nothing -> return Nothing
+ test/TestDocument.hs view
@@ -0,0 +1,390 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-}++module TestDocument (+ allTests,+) where++import System.FilePath ((</>))++import WEditor.Document+import WEditor.LineWrap++import Common+++allTests :: [(String,IO (Maybe String))]+allTests = [+ ("document preserved", checkEditContent+ "original-long.txt"+ "original-long.txt"+ id),+ ("default view at top", checkEditView+ "original-long.txt"+ "default-view.txt"+ id),+ ("zero width skips wrapping", checkEditView+ "original-long.txt"+ "no-wrap-view.txt" $+ viewerResizeAction (0,snd defaultView)),+ ("zero height skips truncation", checkEditView+ "original-long.txt"+ "no-bound-view.txt" $+ composeActions [+ viewerResizeAction (fst defaultView,0),+ repeatAction 4 editorDownAction+ ]),+ ("move cursor below bottom", checkEditView+ "original-long.txt"+ "below-view.txt" $+ repeatAction 15 editorDownAction),+ ("scroll below end of doc", checkEditView+ "original-long.txt"+ "below-bottom-view.txt" $+ repeatAction 100 editorDownAction),+ ("page down puts edit at top and preserves cursor", checkEditView+ "original-long.txt"+ "page-down-view.txt" $+ composeActions [+ repeatAction 4 editorRightAction,+ editorPageDownAction,+ editorAppendAction "XYZ"+ ]),+ ("page up puts edit at top and preserves cursor", checkEditView+ "original-long.txt"+ "page-up-view.txt" $+ composeActions [+ repeatAction 4 editorRightAction,+ repeatAction 15 editorDownAction,+ editorPageUpAction,+ editorAppendAction "XYZ"+ ]),+ ("move previous at doc front", checkEditView+ "original-long.txt"+ "insert-front-view.txt" $+ composeActions [+ editorLeftAction,+ editorAppendAction "XYZ"+ ]),+ ("move next at doc back", checkEditView+ "original-long.txt"+ "insert-back-view.txt" $+ composeActions [+ -- 43 total lines after wrapping => down 42 then to end of line.+ repeatAction 43 editorDownAction,+ editorRightAction,+ editorAppendAction "XYZ"+ ]),+ ("insert in middle view", checkEditView+ "original-long.txt"+ "insert-middle-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ editorAppendAction "XYZ"+ ]),+ ("line position preserved when passing short lines", checkEditView+ "original-long.txt"+ "insert-middle-view.txt" $+ composeActions [+ repeatAction 7 editorRightAction,+ -- This traverses past empty lines after the line position is set.+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ editorAppendAction "XYZ"+ ]),+ ("insert in middle content", checkEditContent+ "original-long.txt"+ "insert-middle-flat.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ editorAppendAction "XYZ"+ ]),+ ("delete in middle view", checkEditView+ "original-long.txt"+ "delete-middle-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ repeatAction 3 editorBackspaceAction+ ]),+ ("delete in middle content", checkEditContent+ "original-long.txt"+ "delete-middle-flat.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ repeatAction 3 editorBackspaceAction+ ]),+ ("join with previous", checkEditView+ "original-long.txt"+ "join-prev-view.txt" $+ composeActions [+ repeatAction 9 editorDownAction,+ editorBackspaceAction+ ]),+ ("join with next", checkEditView+ "original-long.txt"+ "join-next-view.txt" $+ composeActions [+ repeatAction 9 editorDownAction,+ editorLeftAction,+ editorDeleteAction+ ]),+ ("break in middle before", checkEditView+ "original-long.txt"+ "break-before-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ editorEnterAction,+ editorAppendAction "XYZ"+ ]),+ ("break in middle after", checkEditView+ "original-long.txt"+ "break-after-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 7 editorRightAction,+ flip breakPara EditAfter,+ editorInsertAction "XYZ"+ ]),+ ("resize smaller preserves line offset and cursor", checkEditView+ "original-long.txt"+ "resize-smaller-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 3 editorRightAction,+ viewerResizeAction smallerView,+ editorInsertAction "XYZ"+ ]),+ ("resize smaller truncates offset", checkEditView+ "original-long.txt"+ "resize-truncate-view.txt" $+ composeActions [+ repeatAction 9 editorDownAction,+ editorInsertAction "XYZ"+ ]),+ ("resize larger preserves line offset and cursor", checkEditView+ "original-long.txt"+ "resize-larger-view.txt" $+ composeActions [+ repeatAction 15 editorDownAction,+ repeatAction 5 editorUpAction,+ repeatAction 3 editorRightAction,+ viewerResizeAction largerView,+ editorInsertAction "XYZ"+ ]),+ ("cursor/edit defaults to top left", checkEditCursor breakExact+ "original-long.txt" (0,0) (0,0) $+ id),+ ("cursor/edit in middle of view", checkEditCursor breakExact+ "original-long.txt" (5,5) (2,25) $+ composeActions [+ -- NOTE: Keep horizontal first here.+ repeatAction 5 editorRightAction,+ repeatAction 5 editorDownAction+ ]),+ ("cursor/edit after insert before", checkEditCursor breakExact+ "original-long.txt" (8,5) (2,28) $+ composeActions [+ repeatAction 5 editorRightAction,+ repeatAction 5 editorDownAction,+ editorAppendAction "XYZ"+ ]),+ ("cursor/edit after insert after", checkEditCursor breakExact+ "original-long.txt" (5,5) (2,25) $+ composeActions [+ repeatAction 5 editorRightAction,+ repeatAction 5 editorDownAction,+ editorInsertAction "XYZ"+ ]),+ ("cursor/edit after delete before", checkEditCursor breakExact+ "original-long.txt" (4,5) (2,24) $+ composeActions [+ repeatAction 5 editorRightAction,+ repeatAction 5 editorDownAction,+ editorBackspaceAction+ ]),+ ("cursor/edit after delete after", checkEditCursor breakExact+ "original-long.txt" (5,5) (2,25) $+ composeActions [+ repeatAction 5 editorRightAction,+ repeatAction 5 editorDownAction,+ editorDeleteAction+ ]),+ ("cursor/edit after insert before line front", checkEditCursor breakExact+ "original-long.txt" (3,5) (2,23) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorAppendAction "XYZ"+ ]),+ ("cursor/edit after insert after line back", checkEditCursor breakExact+ "original-long.txt" (20,5) (2,40) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorEndAction,+ editorInsertAction "XYZ"+ ]),+ ("cursor/edit after delete before line front", checkEditCursor breakExact+ "original-long.txt" (19,4) (2,19) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorBackspaceAction+ ]),+ ("cursor/edit after delete after line back", checkEditCursor breakExact+ "original-long.txt" (20,5) (2,40) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorEndAction,+ editorDeleteAction+ ]),+ ("cursor/edit scroll to previous line", checkEditCursor breakExact+ "original-long.txt" (20,4) (2,20) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorLeftAction+ ]),+ ("cursor/edit scroll to next line", checkEditCursor breakExact+ "original-long.txt" (0,6) (2,40) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorEndAction,+ editorRightAction+ ]),+ ("cursor/edit after join with prev", checkEditCursor breakExact+ "original-long.txt" (8,8) (2,88) $+ composeActions [+ repeatAction 9 editorDownAction,+ editorBackspaceAction+ ]),+ ("cursor/edit after join with next", checkEditCursor breakExact+ "original-long.txt" (8,8) (2,88) $+ composeActions [+ repeatAction 8 editorDownAction,+ editorEndAction,+ editorDeleteAction+ ]),+ ("cursor/edit after resize preserves offset", checkEditCursor breakExact+ "original-long.txt" (0,3) (1,0) $+ composeActions [+ repeatAction 3 editorDownAction,+ viewerResizeAction largerView+ ]),+ ("cursor/edit after resize larger truncates offset", checkEditCursor breakExact+ "original-short.txt" (20,2) (1,20) $+ composeActions [+ repeatAction 3 editorDownAction,+ viewerResizeAction largerView+ ]),+ ("cursor/edit after resize unbounded maximizes offset", checkEditCursor breakExact+ "original-long.txt" (0,15) (4,60) $+ composeActions [+ repeatAction 15 editorDownAction,+ viewerResizeAction (fst defaultView,0)+ ]),+ ("cursor/edit after resize smaller accounts for new break", checkEditCursor breakExact+ "original-long.txt" (2,4) (2,20) $+ composeActions [+ repeatAction 4 editorDownAction,+ editorEndAction,+ viewerResizeAction smallerView+ ]),+ ("cursor/edit after resize larger accounts for new break", checkEditCursor breakExact+ "original-long.txt" (16,5) (2,40) $+ composeActions [+ repeatAction 5 editorDownAction,+ editorEndAction,+ viewerResizeAction largerView+ ]),+ ("cursor/edit position uses parser tweaking", checkEditCursor (breakWords noHyphen)+ "original-long.txt" (17,0) (0,18) $+ composeActions [+ -- The first line has 18 chars with a space.+ editorDownAction,+ editorLeftAction+ ]),+ ("edit position is truncated within paragraph", checkEditCursor breakExact+ "original-long.txt" (2,0) (3,42) $+ editorSetPositionAction (3,60)),+ ("negative edit position within paragraph", checkEditCursor breakExact+ "original-long.txt" (0,0) (0,0) $+ editorSetPositionAction (0,-5)),+ ("edit position is truncated within document", checkEditCursor breakExact+ "original-long.txt" (10,0) (12,10) $+ editorSetPositionAction (30,10)),+ ("negative edit position within document", checkEditCursor breakExact+ "original-long.txt" (0,0) (0,0) $+ editorSetPositionAction (-5,0)),+ ("edit position can traverse upward", checkEditCursor breakExact+ "original-long.txt" (20,9) (3,40) $+ composeActions [+ repeatAction 40 editorDownAction,+ editorSetPositionAction (3,40)+ ])+ ]++testFilesRoot = "test" </> "testfiles"++defaultView = (20,10)+largerView = (24,12)+smallerView = (18,9)++splitParas = map UnparsedPara . lines++joinParas = unlines . map upText++loadDoc b = viewerResizeAction defaultView . editDocument b . splitParas++checkEditContent fx fy f = do+ edit <- fmap (f . loadDoc breakExact) $ readFile (testFilesRoot </> fx)+ view <- readFile (testFilesRoot </> fy)+ let restored = joinParas $ exportData edit+ checkCondition ("\n" ++ restored) (restored == view)++checkEditView fx fy f = do+ edit <- fmap (f . loadDoc breakExact) $ readFile (testFilesRoot </> fx)+ view <- fmap (map trimSpace . lines) $ readFile (testFilesRoot </> fy)+ let restored = map trimSpace $ getVisible edit+ checkCondition ("\n" ++ unlines restored) (restored == view)++checkEditCursor b fx c e f = do+ edit <- fmap (f . loadDoc b) $ readFile (testFilesRoot </> fx)+ let cursor = getCursor edit+ let point = getEditPoint edit+ checkConditions [+ ("Cursor: " ++ show cursor,cursor == c),+ ("Edit: " ++ show point, point == e)+ ]++-- Just in case the text editor used to create the test file prunes whitespace+-- from the end of the line.+trimSpace = reverse . trim . reverse where+ trim (' ':cs) = trim cs+ trim cs = cs
+ test/TestLine.hs view
@@ -0,0 +1,186 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE Safe #-}++module TestLine (+ allTests,+) where++import WEditor.Base+import WEditor.LineWrap+import WEditor.Internal.Line++import Common+++allTests :: [(String,IO (Maybe String))]+allTests = [+ ("edit preserves line", checkLineEdit+ "this is a test line"+ "this is a test line"+ id),+ ("bounded cursor move preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ repeatAction 5 (moveLineCursor MoveNext)),+ ("undershot cursor move preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ repeatAction 100 (moveLineCursor MovePrev)),+ ("overshot cursor move preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ repeatAction 100 (moveLineCursor MoveNext)),+ ("bounded cursor seek preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ setLineCursor 5),+ ("undershot cursor seek preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ setLineCursor (-5)),+ ("overshot cursor seek preserves line", checkLineEdit+ "this is a test line"+ "this is a test line" $+ setLineCursor 100),+ ("insert before", checkLineEdit+ "this is a test line"+ "this XYis a test line" $+ composeActions [+ setLineCursor 5,+ modifyLine (InsertText "X") EditBefore,+ modifyLine (InsertText "Y") EditBefore+ ]),+ ("insert after", checkLineEdit+ "this is a test line"+ "this YXis a test line" $+ composeActions [+ setLineCursor 5,+ modifyLine (InsertText "X") EditAfter,+ modifyLine (InsertText "Y") EditAfter+ ]),+ ("delete before", checkLineEdit+ "this is a test line"+ "thiis a test line" $+ composeActions [+ setLineCursor 5,+ modifyLine DeleteText EditBefore,+ modifyLine DeleteText EditBefore+ ]),+ ("delete after", checkLineEdit+ "this is a test line"+ "this a test line" $+ composeActions [+ setLineCursor 5,+ modifyLine DeleteText EditAfter,+ modifyLine DeleteText EditAfter+ ]),+ ("insert at front", checkLineEdit+ "this is a test line"+ "Xthis is a test line" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveHome,+ modifyLine (InsertText "X") EditAfter+ ]),+ ("insert at back", checkLineEdit+ "this is a test line"+ "this is a test lineX" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveEnd,+ modifyLine (InsertText "X") EditAfter+ ]),+ ("delete after front", checkLineEdit+ "this is a test line"+ "his is a test line" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveHome,+ modifyLine DeleteText EditAfter+ ]),+ ("delete before front", checkLineEdit+ "this is a test line"+ "this is a test line" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveHome,+ modifyLine DeleteText EditBefore+ ]),+ ("delete before back", checkLineEdit+ "this is a test line"+ "this is a test lin" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveEnd,+ modifyLine DeleteText EditBefore+ ]),+ ("delete after back", checkLineEdit+ "this is a test line"+ "this is a test line" $+ composeActions [+ setLineCursor 5,+ moveLineCursor MoveEnd,+ modifyLine DeleteText EditAfter+ ]),+ ("split line middle", do+ let line = editLine $ innerLine "this is a test line"+ let (left,right) = splitLine lineBreakEnd $ setLineCursor 5 line+ checkConditions [+ ("Left: " ++ show left,left == (endLine "this ")),+ ("Right: " ++ show right,right == (innerLine "is a test line"))+ ]),+ ("split line front", do+ let line = editLine $ innerLine "this is a test line"+ let (left,right) = splitLine lineBreakEnd $ moveLineCursor MoveUp line+ checkConditions [+ ("Left: " ++ show left,left == (endLine "")),+ ("Right: " ++ show right,right == (innerLine "this is a test line"))+ ]),+ ("split line back", do+ let line = editLine $ innerLine "this is a test line"+ let (left,right) = splitLine lineBreakEnd $ moveLineCursor MoveDown line+ checkConditions [+ ("Left: " ++ show left,left == (endLine "this is a test line")),+ ("Right: " ++ show right,right == (innerLine ""))+ ]),+ ("prepend preserves cursor", checkLineEdit+ "this is a test line"+ "XYthis Zis a test line" $+ composeActions [+ setLineCursor 5,+ prependToLine (innerLine "XY"),+ modifyLine (InsertText "Z") EditAfter+ ]),+ ("append preserves cursor", checkLineEdit+ "this is a test line"+ "this Zis a test lineXY" $+ composeActions [+ setLineCursor 5,+ flip appendToLine (endLine "XY"),+ modifyLine (InsertText "Z") EditAfter+ ])+ ]++checkLineEdit x y f = do+ let lx = endLine x+ let ly = endLine y+ let edit = f (editLine lx)+ let restored = viewLine edit+ checkCondition (show restored) (restored == ly)
+ test/TestLineWrap.hs view
@@ -0,0 +1,213 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use This file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-}++module TestLineWrap (+ allTests,+) where++import WEditor.Base+import WEditor.LineWrap++import Common+++allTests :: [(String,IO (Maybe String))]+allTests = [+ ("breakExact skips breaks by default", checkLineBreak+ breakExact+ "This is a test line."+ [endLine "This is a test line."]),+ ("breakExact empty still provides line", checkLineBreak+ breakExact+ ""+ [endLine ""]),+ ("breakExact exact multiple", checkLineBreak+ (setLineWidth breakExact 5)+ "This is a test line."+ [innerLine "This ",+ innerLine "is a ",+ innerLine "test ",+ endLine "line."]),+ ("breakExact not a multiple", checkLineBreak+ (setLineWidth breakExact 7)+ "This is a test line."+ [innerLine "This is",+ innerLine " a test",+ endLine " line."]),+ ("breakExact preserves data", do+ let breaker = setLineWidth breakExact 7+ let line = "This is a test line."+ let restored = concat $ map vlText $ breakLines breaker line+ checkCondition (show restored) (restored == line)),+ ("noHyphen skips breaks by default", checkLineBreak+ (breakWords noHyphen)+ "This is a test line."+ [endLine "This is a test line."]),+ ("noHyphen empty still provides line", checkLineBreak+ (breakWords noHyphen)+ ""+ [endLine ""]),+ ("noHyphen exact multiple", checkLineBreak+ (setLineWidth (breakWords noHyphen) 5)+ "This is a test line."+ [innerLine "This ",+ innerLine "is a ",+ innerLine "test ",+ endLine "line."]),+ ("noHyphen not a multiple", checkLineBreak+ (setLineWidth (breakWords noHyphen) 7)+ "This is a test line."+ [innerLine "This is ",+ innerLine "a test ",+ endLine "line."]),+ ("noHyphen allows extra hidden spaces at end", checkLineBreak+ (setLineWidth (breakWords noHyphen) 5)+ "Here are some extra spaces alongwordthatwillnotfit. "+ [innerLine "Here ",+ innerLine "are ",+ innerLine "some ",+ innerLine "extra ",+ innerLine "space",+ innerLine "s ",+ innerLine "along",+ innerLine "wordt",+ innerLine "hatwi",+ innerLine "llnot",+ endLine "fit. "]),+ ("noHyphen preserves data", do+ let breaker = setLineWidth (breakWords noHyphen) 5+ let line = "Here are some extra spaces. "+ let restored = concat $ map vlText $ breakLines breaker line+ checkCondition (show restored) (restored == line)),+ ("lazyHyphen skips short words", checkWordBreaks+ (splitWord lazyHyphen 0 7) "the" $ Just []),+ ("lazyHyphen with single break", checkWordBreaks+ (splitWord lazyHyphen 4 7) "hyphenate" $ Just [3]),+ ("lazyHyphen with multiple break", checkWordBreaks+ (splitWord lazyHyphen 4 5) "hyphenation" $ Just [3,4]),+ ("lazyHyphen skips short break", checkWordBreaks+ (splitWord lazyHyphen 2 5) "hyphenate" $ Just []),+ ("lazyHyphen skips avoids short end", checkWordBreaks+ (splitWord lazyHyphen 9 10) "hyphenate" $ Just []),+ ("lazyHyphen skips breaks by default", checkLineBreak+ (breakWords lazyHyphen)+ "This is a test line."+ [endLine "This is a test line."]),+ ("lazyHyphen empty still provides line", checkLineBreak+ (breakWords lazyHyphen)+ ""+ [endLine ""]),+ ("lazyHyphen exact multiple", checkLineBreak+ (setLineWidth (breakWords lazyHyphen) 5)+ "This is a test line."+ [innerLine "This ",+ innerLine "is a ",+ innerLine "test ",+ endLine "line."]),+ ("lazyHyphen not a multiple", checkLineBreak+ (setLineWidth (breakWords lazyHyphen) 7)+ "This is a test line."+ [innerLine "This is ",+ innerLine "a test ",+ endLine "line."]),+ ("lazyHyphen allows extra hidden spaces after last break", checkLineBreak+ (setLineWidth (breakWords lazyHyphen) 7)+ "Here are some extra spaces and alongwordthatwillnotfit. "+ [innerLine "Here ",+ hyphenLine "are so",+ hyphenLine "me ext",+ hyphenLine "ra spa",+ innerLine "ces and ",+ hyphenLine "alongw",+ hyphenLine "ordtha",+ hyphenLine "twilln",+ endLine "otfit. "]),+ ("lazyHyphen breaks long word in middle of line", checkLineBreak+ (setLineWidth (breakWords lazyHyphen) 7)+ " averylongword"+ [hyphenLine " ave",+ hyphenLine "rylong",+ endLine "word"]),+ ("lazyHyphen breaks word bumped to next line", checkLineBreak+ (setLineWidth (breakWords lazyHyphen) 5)+ " averylongword"+ [innerLine " ",+ hyphenLine "aver",+ hyphenLine "ylon",+ endLine "gword"]),+ ("lazyHyphen preserves data", do+ let breaker = setLineWidth (breakWords lazyHyphen) 7+ let line = "Here are some extra spaces and alongwordthatwillnotfit. "+ let restored = concat $ map vlText $ breakLines breaker line+ checkCondition (show restored) (restored == line)),+ ("breakWords trims only trailing spaces", checkLineRender+ (breakWords noHyphen)+ (innerLine " This line had extra spaces. ")+ " This line had extra spaces."),+ ("breakWords trims allows spaces at paragraph end", checkLineRender+ (setLineWidth (breakWords noHyphen) 30)+ (endLine " This line had extra spaces. ")+ " This line had extra spaces. "),+ ("breakWords adds a hyphen", checkLineRender+ (breakWords lazyHyphen)+ (hyphenLine "somet")+ "somet-"),+ ("breakWords adds a hyphen even with spaces", checkLineRender+ (breakWords lazyHyphen)+ (hyphenLine "weird ")+ "weird -"),+ ("breakWords no tweak in leading spaces", checkCursorTweak+ (breakWords noHyphen)+ (innerLine " This line had extra spaces. ")+ 1 1),+ ("breakWords no tweak in middle", checkCursorTweak+ (breakWords noHyphen)+ (innerLine " This line had extra spaces. ")+ 10 10),+ ("breakWords tweak at back", checkCursorTweak+ (breakWords noHyphen)+ (innerLine " This line had extra spaces. ")+ 29 29),+ ("breakWords tweak in trailing spaces", checkCursorTweak+ (breakWords noHyphen)+ (innerLine " This line had extra spaces. ")+ 31 29),+ ("breakWords tweak allows spaces at paragraph end", checkCursorTweak+ (setLineWidth (breakWords noHyphen) 30)+ (endLine " This line had extra spaces. ")+ 31 30)+ ]++checkLineBreak b x ys = do+ let breaks = breakLines b x+ checkCondition (show breaks) (breaks == ys)++checkLineRender b x y = do+ let rendered = renderLine b x+ checkCondition (show rendered) (rendered == y)++checkCursorTweak b x k j = do+ let tweaked = tweakCursor b x k+ checkCondition (show tweaked) (tweaked == j)++checkWordBreaks f x y = do+ let breaks = f x+ checkCondition (show breaks) (breaks == y)
+ test/TestPara.hs view
@@ -0,0 +1,371 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Safe #-}++module TestPara (+ allTests,+) where++import WEditor.LineWrap+import WEditor.Base+import WEditor.Internal.Para++import Common+++allTests :: [(String,IO (Maybe String))]+allTests = [+ ("edit preserves paragraph", checkParaEdit+ commonParser+ examplePara+ examplePara+ id),+ ("edit starts at top", checkParaStructure+ commonParser+ examplePara+ ([],+ ("This is a test ",0,0),+ ["paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo",+ "sed to."])+ id),+ ("move cursor down", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related"],+ (" things work as",0,60),+ [" they are suppo",+ "sed to."]) $+ repeatAction 4 (moveParaCursor MoveDown)),+ ("move cursor below bottom", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo"],+ ("sed to.",7,97),+ []) $+ repeatAction 20 (moveParaCursor MoveDown)),+ ("move cursor above top", checkParaStructure+ commonParser+ examplePara+ ([],+ ("This is a test ",0,0),+ ["paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo",+ "sed to."]) $+ repeatAction 5 (moveParaCursor MoveUp)),+ ("move up at top sets to paragraph front", checkParaStructure+ commonParser+ examplePara+ ([],+ ("XYZThis is a te",3,3),+ ["st paragraph to",+ " make sure that",+ " paragraph-rela",+ "ted things work",+ " as they are su",+ "pposed to."]) $+ composeActions [+ repeatAction 5 (moveParaCursor MoveNext),+ moveParaCursor MoveUp,+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("move down at bottom sets to paragraph back", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo"],+ ("sed to.XYZ",10,100),+ []) $+ composeActions [+ repeatAction 7 (moveParaCursor MoveDown),+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("continue to next line", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma"],+ ("ke sure that pa",0,30),+ ["ragraph-related",+ " things work as",+ " they are suppo",+ "sed to."]) $+ repeatAction 32 (moveParaCursor MoveNext)),+ ("continue to previous line", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma"],+ ("ke sure that pa",15,45),+ ["ragraph-related",+ " things work as",+ " they are suppo",+ "sed to."]) $+ composeActions [+ repeatAction 5 (moveParaCursor MoveDown),+ repeatAction 33 (moveParaCursor MovePrev)+ ]),+ ("insert at front", checkParaStructure+ commonParser+ examplePara+ ([],+ ("XYZThis is a te",3,3),+ ["st paragraph to",+ " make sure that",+ " paragraph-rela",+ "ted things work",+ " as they are su",+ "pposed to."]) $+ composeActions [+ repeatAction 5 (moveParaCursor MoveDown),+ repeatAction 5 (moveParaCursor MoveNext),+ seekParaFront,+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("insert at back", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo"],+ ("sed to.XYZ",10,100),+ []) $+ composeActions [+ repeatAction 5 (moveParaCursor MoveDown),+ repeatAction 5 (moveParaCursor MoveNext),+ seekParaBack,+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("insert in middle", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related"],+ (" thiXYZngs work",7,67),+ [" as they are su",+ "pposed to."]) $+ composeActions [+ repeatAction 4 (moveParaCursor MoveDown),+ repeatAction 4 (moveParaCursor MoveNext),+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("delete after front", checkParaStructure+ commonParser+ examplePara+ ([],+ ("his is a test p",0,0),+ ["aragraph to mak",+ "e sure that par",+ "agraph-related ",+ "things work as ",+ "they are suppos",+ "ed to."]) $+ composeActions [+ seekParaFront,+ modifyPara commonParser DeleteText EditAfter+ ]),+ ("delete before front", checkParaStructure+ commonParser+ examplePara+ ([],+ ("This is a test ",0,0),+ ["paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo",+ "sed to."]) $+ composeActions [+ seekParaFront,+ modifyPara commonParser DeleteText EditBefore+ ]),+ ("delete before back", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo"],+ ("sed to",6,96),+ []) $+ composeActions [+ seekParaBack,+ modifyPara commonParser DeleteText EditBefore+ ]),+ ("delete after back", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa",+ "ragraph-related",+ " things work as",+ " they are suppo"],+ ("sed to.",7,97),+ []) $+ composeActions [+ seekParaBack,+ modifyPara commonParser DeleteText EditAfter+ ]),+ ("delete before line front", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa"],+ ("ragraph-relate ",14,59),+ ["things work as ",+ "they are suppos",+ "ed to."]) $+ composeActions [+ repeatAction 4 (moveParaCursor MoveDown),+ modifyPara commonParser DeleteText EditBefore+ ]),+ ("delete after line back", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa"],+ ("ragraph-related",15,60),+ ["things work as ",+ "they are suppos",+ "ed to."]) $+ composeActions [+ repeatAction 4 (moveParaCursor MoveDown),+ moveParaCursor MovePrev,+ modifyPara commonParser DeleteText EditAfter+ ]),+ ("split paragraph middle", do+ let para = repeatAction 3 (moveParaCursor MoveDown) $+ repeatAction 4 (moveParaCursor MoveNext) $+ editPara commonParser examplePara+ let (top,bottom) = splitPara commonParser para+ checkConditions [+ ("Top: " ++ show (upText top),+ upText top == "This is a test paragraph to make sure that paragr"),+ ("Bottom: " ++ show (upText bottom),+ upText bottom == "aph-related things work as they are supposed to.")+ ]),+ ("split paragraph front", do+ let para = seekParaFront $ editPara commonParser examplePara+ let (top,bottom) = splitPara commonParser para+ checkConditions [+ ("Top: " ++ show (upText top),+ upText top == ""),+ ("Bottom: " ++ show (upText bottom),+ upText bottom == "This is a test paragraph to make sure that paragraph-related things work as they are supposed to.")+ ]),+ ("split paragraph back", do+ let para = seekParaBack $ editPara commonParser examplePara+ let (top,bottom) = splitPara commonParser para+ checkConditions [+ ("Top: " ++ show (upText top),+ upText top == "This is a test paragraph to make sure that paragraph-related things work as they are supposed to."),+ ("Bottom: " ++ show (upText bottom),+ upText bottom == "")+ ]),+ ("prepend preserves cursor", checkParaStructure+ commonParser+ examplePara+ (["This is some ex",+ "tra stuff. This",+ " is a test para",+ "graph to make s",+ "ure that paragr"],+ ("aphXYZ-related ",6,81),+ ["things work as ",+ "they are suppos",+ "ed to."]) $+ composeActions [+ repeatAction 3 (moveParaCursor MoveDown),+ repeatAction 7 (moveParaCursor MoveNext),+ prependToPara commonParser (parseParaBefore commonParser $ UnparsedPara "This is some extra stuff. "),+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ]),+ ("append preserves cursor", checkParaStructure+ commonParser+ examplePara+ (["This is a test ",+ "paragraph to ma",+ "ke sure that pa"],+ ("ragraphXYZ-rela",10,55),+ ["ted things work",+ " as they are su",+ "pposed to. This",+ " is some extra ",+ "stuff."]) $+ composeActions [+ repeatAction 3 (moveParaCursor MoveDown),+ repeatAction 7 (moveParaCursor MoveNext),+ flip (appendToPara commonParser) (parseParaAfter commonParser $ UnparsedPara " This is some extra stuff."),+ modifyPara commonParser (InsertText "XYZ") EditBefore+ ])+ ]++commonParser :: BreakWords Char+commonParser = setLineWidth breakExact 15++examplePara = UnparsedPara "This is a test paragraph to make sure that paragraph-related things work as they are supposed to."++checkParaEdit p x y f = do+ let edit = f $ editPara p x+ let restored = unparsePara edit+ checkCondition (show restored) (restored == y)++checkParaStructure p x (yb,(yl,c,e),ya) f = do+ let edit = f $ editPara p x+ let before = map vlText $ viewBeforeLines $ getBeforeLines edit+ let line = vlText $ getCurrentLine edit+ let after = map vlText $ viewAfterLines $ getAfterLines edit+ let cursor = getParaCursorChar edit+ let point = getParaEditChar edit+ checkConditions [+ ("Before: " ++ show before,before == yb),+ ("Line: " ++ show line, line == yl),+ ("After: " ++ show after, after == ya),+ ("Cursor: " ++ show cursor,cursor == c),+ ("Edit: " ++ show point, point == e)+ ]
+ test/test.hs view
@@ -0,0 +1,44 @@+{- -----------------------------------------------------------------------------+Copyright 2020 Kevin P. Barry++Licensed under the Apache License, Version 2.0 (the "License");+you may not use this file except in compliance with the License.+You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++Unless required by applicable law or agreed to in writing, software+distributed under the License is distributed on an "AS IS" BASIS,+WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+See the License for the specific language governing permissions and+limitations under the License.+----------------------------------------------------------------------------- -}++-- Author: Kevin P. Barry [ta0kira@gmail.com]++{-# LANGUAGE Safe #-}++import Control.Monad+import System.Directory+import System.Exit+import System.IO++import Common (runTests)+import qualified TestDocument as TestDocument (allTests)+import qualified TestLine as TestLine (allTests)+import qualified TestLineWrap as TestLineWrap (allTests)+import qualified TestPara as TestPara (allTests)+++main = do+ cwd <- getCurrentDirectory+ hPutStrLn stderr $ "Running from " ++ cwd+ failures <- fmap sum $ sequence [+ runTests "LineWrap Tests" TestLineWrap.allTests,+ runTests "Line Tests" TestLine.allTests,+ runTests "Para Tests" TestPara.allTests,+ runTests "Document Tests" TestDocument.allTests+ ]+ when (failures > 0) $ do+ hPutStrLn stderr $ "### TEST FAILURES: " ++ show failures ++ " ###"+ exitFailure
+ test/testfiles/below-bottom-view.txt view
@@ -0,0 +1,1 @@+nce in it?
+ test/testfiles/below-view.txt view
@@ -0,0 +1,10 @@+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is all very contrive+d.+It would certainly s+uffice to just fill+it with random chara+cters, but this will
+ test/testfiles/break-after-view.txt view
@@ -0,0 +1,10 @@+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is all XYZ+very contrived.+It would certainly s+uffice to just fill+it with random chara+cters, but this will
+ test/testfiles/break-before-view.txt view
@@ -0,0 +1,10 @@+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is all+XYZvery contrived.+It would certainly s+uffice to just fill+it with random chara+cters, but this will
+ test/testfiles/default-view.txt view
@@ -0,0 +1,10 @@+I need a lot more te+xt here in order to+test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file
+ test/testfiles/delete-middle-flat.txt view
@@ -0,0 +1,13 @@+I need a lot more text here in order to test out viewing.++I also need some more paragraphs so that some are out of view, and thus remain unparsed.+Honestly, this file is avery contrived.+It would certainly suffice to just fill it with random characters, but this will be easier to read in test output.++Since the view buffer has five parts to it, we need at least five paragraphs.+But, that five number is already out-of-date.+Or, that's at least the situation as it stands now.+There are also a few random extra lines to see how "empty" paragraphs are handled.++I can't seem to stop writing paragraphs, even though this is just a test file.+Isn't it annoying how each paragraph only has a single sentence in it?
+ test/testfiles/delete-middle-view.txt view
@@ -0,0 +1,10 @@+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is avery contrived.+It would certainly s+uffice to just fill+it with random chara+cters, but this will+ be easier to read i
+ test/testfiles/insert-back-view.txt view
@@ -0,0 +1,10 @@+d.++I can't seem to stop+ writing paragraphs,+ even though this is+ just a test file.+Isn't it annoying ho+w each paragraph onl+y has a single sente+nce in it?XYZ
+ test/testfiles/insert-front-view.txt view
@@ -0,0 +1,10 @@+XYZI need a lot more+ text here in order+to test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file
+ test/testfiles/insert-middle-flat.txt view
@@ -0,0 +1,13 @@+I need a lot more text here in order to test out viewing.++I also need some more paragraphs so that some are out of view, and thus remain unparsed.+Honestly, this file is all XYZvery contrived.+It would certainly suffice to just fill it with random characters, but this will be easier to read in test output.++Since the view buffer has five parts to it, we need at least five paragraphs.+But, that five number is already out-of-date.+Or, that's at least the situation as it stands now.+There are also a few random extra lines to see how "empty" paragraphs are handled.++I can't seem to stop writing paragraphs, even though this is just a test file.+Isn't it annoying how each paragraph only has a single sentence in it?
+ test/testfiles/insert-middle-view.txt view
@@ -0,0 +1,10 @@+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is all XYZvery contr+ived.+It would certainly s+uffice to just fill+it with random chara+cters, but this will
+ test/testfiles/join-next-view.txt view
@@ -0,0 +1,10 @@+I need a lot more te+xt here in order to+test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.Honestly, th+is file is all very
+ test/testfiles/join-prev-view.txt view
@@ -0,0 +1,10 @@+I need a lot more te+xt here in order to+test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.Honestly, th+is file is all very
+ test/testfiles/no-bound-view.txt view
@@ -0,0 +1,43 @@+I need a lot more te+xt here in order to+test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.+Honestly, this file+is all very contrive+d.+It would certainly s+uffice to just fill+it with random chara+cters, but this will+ be easier to read i+n test output.++Since the view buffe+r has five parts to+it, we need at least+ five paragraphs.+But, that five numbe+r is already out-of-+date.+Or, that's at least+the situation as it+stands now.+There are also a few+ random extra lines+to see how "empty" p+aragraphs are handle+d.++I can't seem to stop+ writing paragraphs,+ even though this is+ just a test file.+Isn't it annoying ho+w each paragraph onl+y has a single sente+nce in it?
+ test/testfiles/no-wrap-view.txt view
@@ -0,0 +1,10 @@+I need a lot more text here in order to test out viewing.++I also need some more paragraphs so that some are out of view, and thus remain unparsed.+Honestly, this file is all very contrived.+It would certainly suffice to just fill it with random characters, but this will be easier to read in test output.++Since the view buffer has five parts to it, we need at least five paragraphs.+But, that five number is already out-of-date.+Or, that's at least the situation as it stands now.+There are also a few random extra lines to see how "empty" paragraphs are handled.
+ test/testfiles/original-long.txt view
@@ -0,0 +1,13 @@+I need a lot more text here in order to test out viewing.++I also need some more paragraphs so that some are out of view, and thus remain unparsed.+Honestly, this file is all very contrived.+It would certainly suffice to just fill it with random characters, but this will be easier to read in test output.++Since the view buffer has five parts to it, we need at least five paragraphs.+But, that five number is already out-of-date.+Or, that's at least the situation as it stands now.+There are also a few random extra lines to see how "empty" paragraphs are handled.++I can't seem to stop writing paragraphs, even though this is just a test file.+Isn't it annoying how each paragraph only has a single sentence in it?
+ test/testfiles/original-short.txt view
@@ -0,0 +1,3 @@+This is a shorter test doc.+It has 3 paragraphs, just in case.+Definitely a struggle.
+ test/testfiles/page-down-view.txt view
@@ -0,0 +1,10 @@+is aXYZll very contr+ived.+It would certainly s+uffice to just fill+it with random chara+cters, but this will+ be easier to read i+n test output.++Since the view buffe
+ test/testfiles/page-up-view.txt view
@@ -0,0 +1,10 @@+e paXYZragraphs so t+hat some are out of+view, and thus remai+n unparsed.+Honestly, this file+is all very contrive+d.+It would certainly s+uffice to just fill+it with random chara
+ test/testfiles/resize-larger-view.txt view
@@ -0,0 +1,12 @@+I also need some more pa+ragraphs so that some ar+e out of view, and thus+remain unparsed.+Honestly, this file is X+YZall very contrived.+It would certainly suffi+ce to just fill it with+random characters, but t+his will be easier to re+ad in test output.+
+ test/testfiles/resize-smaller-view.txt view
@@ -0,0 +1,9 @@+that some are out+of view, and thus+remain unparsed.+Honestly, this fil+e is XYZall very c+ontrived.+It would certainly+ suffice to just f+ill it with random
+ test/testfiles/resize-truncate-view.txt view
@@ -0,0 +1,10 @@+I need a lot more te+xt here in order to+test out viewing.++I also need some mor+e paragraphs so that+ some are out of vie+w, and thus remain u+nparsed.+XYZHonestly, this fi