diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for WEditor + +## 0.1.0.0 -- 2020-04-14 + +* First version. Released on an unsuspecting world. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/WEditor.cabal b/WEditor.cabal new file mode 100644 --- /dev/null +++ b/WEditor.cabal @@ -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 diff --git a/WEditor/Base.hs b/WEditor/Base.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base.hs @@ -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 diff --git a/WEditor/Base/Char.hs b/WEditor/Base/Char.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Char.hs @@ -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 = '-' diff --git a/WEditor/Base/Editor.hs b/WEditor/Base/Editor.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Editor.hs @@ -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 diff --git a/WEditor/Base/Line.hs b/WEditor/Base/Line.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Line.hs @@ -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 diff --git a/WEditor/Base/Para.hs b/WEditor/Base/Para.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Para.hs @@ -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 [] diff --git a/WEditor/Base/Parser.hs b/WEditor/Base/Parser.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Parser.hs @@ -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) [] diff --git a/WEditor/Base/Viewer.hs b/WEditor/Base/Viewer.hs new file mode 100644 --- /dev/null +++ b/WEditor/Base/Viewer.hs @@ -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 diff --git a/WEditor/Document.hs b/WEditor/Document.hs new file mode 100644 --- /dev/null +++ b/WEditor/Document.hs @@ -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 diff --git a/WEditor/Internal/Line.hs b/WEditor/Internal/Line.hs new file mode 100644 --- /dev/null +++ b/WEditor/Internal/Line.hs @@ -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 diff --git a/WEditor/Internal/Para.hs b/WEditor/Internal/Para.hs new file mode 100644 --- /dev/null +++ b/WEditor/Internal/Para.hs @@ -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 diff --git a/WEditor/LineWrap.hs b/WEditor/LineWrap.hs new file mode 100644 --- /dev/null +++ b/WEditor/LineWrap.hs @@ -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 diff --git a/test/Common.hs b/test/Common.hs new file mode 100644 --- /dev/null +++ b/test/Common.hs @@ -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 diff --git a/test/TestDocument.hs b/test/TestDocument.hs new file mode 100644 --- /dev/null +++ b/test/TestDocument.hs @@ -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 diff --git a/test/TestLine.hs b/test/TestLine.hs new file mode 100644 --- /dev/null +++ b/test/TestLine.hs @@ -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) diff --git a/test/TestLineWrap.hs b/test/TestLineWrap.hs new file mode 100644 --- /dev/null +++ b/test/TestLineWrap.hs @@ -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) diff --git a/test/TestPara.hs b/test/TestPara.hs new file mode 100644 --- /dev/null +++ b/test/TestPara.hs @@ -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) + ] diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -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 diff --git a/test/testfiles/below-bottom-view.txt b/test/testfiles/below-bottom-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/below-bottom-view.txt @@ -0,0 +1,1 @@ +nce in it? diff --git a/test/testfiles/below-view.txt b/test/testfiles/below-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/below-view.txt @@ -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 diff --git a/test/testfiles/break-after-view.txt b/test/testfiles/break-after-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/break-after-view.txt @@ -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 diff --git a/test/testfiles/break-before-view.txt b/test/testfiles/break-before-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/break-before-view.txt @@ -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 diff --git a/test/testfiles/default-view.txt b/test/testfiles/default-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/default-view.txt @@ -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 diff --git a/test/testfiles/delete-middle-flat.txt b/test/testfiles/delete-middle-flat.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/delete-middle-flat.txt @@ -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? diff --git a/test/testfiles/delete-middle-view.txt b/test/testfiles/delete-middle-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/delete-middle-view.txt @@ -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 diff --git a/test/testfiles/insert-back-view.txt b/test/testfiles/insert-back-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/insert-back-view.txt @@ -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 diff --git a/test/testfiles/insert-front-view.txt b/test/testfiles/insert-front-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/insert-front-view.txt @@ -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 diff --git a/test/testfiles/insert-middle-flat.txt b/test/testfiles/insert-middle-flat.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/insert-middle-flat.txt @@ -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? diff --git a/test/testfiles/insert-middle-view.txt b/test/testfiles/insert-middle-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/insert-middle-view.txt @@ -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 diff --git a/test/testfiles/join-next-view.txt b/test/testfiles/join-next-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/join-next-view.txt @@ -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 diff --git a/test/testfiles/join-prev-view.txt b/test/testfiles/join-prev-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/join-prev-view.txt @@ -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 diff --git a/test/testfiles/no-bound-view.txt b/test/testfiles/no-bound-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/no-bound-view.txt @@ -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? diff --git a/test/testfiles/no-wrap-view.txt b/test/testfiles/no-wrap-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/no-wrap-view.txt @@ -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. diff --git a/test/testfiles/original-long.txt b/test/testfiles/original-long.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/original-long.txt @@ -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? diff --git a/test/testfiles/original-short.txt b/test/testfiles/original-short.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/original-short.txt @@ -0,0 +1,3 @@ +This is a shorter test doc. +It has 3 paragraphs, just in case. +Definitely a struggle. diff --git a/test/testfiles/page-down-view.txt b/test/testfiles/page-down-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/page-down-view.txt @@ -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 diff --git a/test/testfiles/page-up-view.txt b/test/testfiles/page-up-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/page-up-view.txt @@ -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 diff --git a/test/testfiles/resize-larger-view.txt b/test/testfiles/resize-larger-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/resize-larger-view.txt @@ -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. + diff --git a/test/testfiles/resize-smaller-view.txt b/test/testfiles/resize-smaller-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/resize-smaller-view.txt @@ -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 diff --git a/test/testfiles/resize-truncate-view.txt b/test/testfiles/resize-truncate-view.txt new file mode 100644 --- /dev/null +++ b/test/testfiles/resize-truncate-view.txt @@ -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