diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,9 @@ +# Changelog + +## [Unreleased] + +## [0.2.0.0] - 2019-09-23 + +### Changed + +- `textFieldCursorInsertChar` and `textFieldCursorAppendChar` now fail on unsafe characters. diff --git a/cursor.cabal b/cursor.cabal --- a/cursor.cabal +++ b/cursor.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.31.2. -- -- see: https://github.com/sol/hpack -- --- hash: 8f3a123718c5c3c3ec43456e3311c0955cd17b64bda527bc0e553a10f783d5bf +-- hash: 198732d25b67091588b88dbc6fd99fc8847ea61c7ebadc1ce7a7f313a60a70eb name: cursor -version: 0.1.0.1 +version: 0.2.0.0 synopsis: Purely Functional Cursors description: Purely Functional Cursors for common data structures . @@ -20,6 +20,8 @@ license: MIT license-file: LICENSE build-type: Simple +extra-source-files: + CHANGELOG.md library exposed-modules: diff --git a/src/Cursor/Text.hs b/src/Cursor/Text.hs --- a/src/Cursor/Text.hs +++ b/src/Cursor/Text.hs @@ -49,7 +49,10 @@ mconcat [ genericValidate lc , decorateList (rebuildListCursor lc) $ \c -> - declare "The character is not a newline character" $ c /= '\n' + mconcat + [ declare "The character is not a newline character" $ c /= '\n' + , declare "The character is a safe character" $ isSafeChar c + ] ] emptyTextCursor :: TextCursor @@ -68,10 +71,7 @@ rebuildTextCursor = T.pack . rebuildListCursor . textCursorList textCursorListCursorL :: - Functor f - => (ListCursor Char -> f (ListCursor Char)) - -> TextCursor - -> f TextCursor + Functor f => (ListCursor Char -> f (ListCursor Char)) -> TextCursor -> f TextCursor textCursorListCursorL = lens textCursorList (\tc lc -> tc {textCursorList = lc}) textCursorNull :: TextCursor -> Bool @@ -106,19 +106,23 @@ textCursorInsert :: Char -> TextCursor -> Maybe TextCursor textCursorInsert '\n' _ = Nothing -textCursorInsert c tc = Just (tc & textCursorListCursorL %~ listCursorInsert c) +textCursorInsert c tc = + if isSafeChar c + then Just (tc & textCursorListCursorL %~ listCursorInsert c) + else Nothing textCursorAppend :: Char -> TextCursor -> Maybe TextCursor textCursorAppend '\n' _ = Nothing -textCursorAppend c tc = Just (tc & textCursorListCursorL %~ listCursorAppend c) +textCursorAppend c tc = + if isSafeChar c + then Just (tc & textCursorListCursorL %~ listCursorAppend c) + else Nothing textCursorRemove :: TextCursor -> Maybe (DeleteOrUpdate TextCursor) -textCursorRemove = - focusPossibleDeleteOrUpdate textCursorListCursorL listCursorRemove +textCursorRemove = focusPossibleDeleteOrUpdate textCursorListCursorL listCursorRemove textCursorDelete :: TextCursor -> Maybe (DeleteOrUpdate TextCursor) -textCursorDelete = - focusPossibleDeleteOrUpdate textCursorListCursorL listCursorDelete +textCursorDelete = focusPossibleDeleteOrUpdate textCursorListCursorL listCursorDelete textCursorSplit :: TextCursor -> (TextCursor, TextCursor) textCursorSplit tc = diff --git a/src/Cursor/TextField.hs b/src/Cursor/TextField.hs --- a/src/Cursor/TextField.hs +++ b/src/Cursor/TextField.hs @@ -62,19 +62,8 @@ mconcat [ genericValidate tfc , decorate "None of the texts contain newlines" $ - mconcat $ - NE.toList $ - flip - NE.map - (NE.zip (fromJust $ NE.nonEmpty [0 ..]) $ - rebuildNonEmptyCursor rebuildTextCursor textFieldCursorNonEmpty) $ \(i, tc) -> - declare - (unwords - [ "The text of the line at index" - , show (i :: Int) - , "does not contain any newlines" - ]) $ - T.all (/= '\n') tc + decorateList (NE.toList $ rebuildNonEmptyCursor rebuildTextCursor textFieldCursorNonEmpty) $ \tc -> + declare "The text of this line does not contain any newlines" $ T.all (/= '\n') tc ] makeTextFieldCursor :: Text -> TextFieldCursor @@ -82,32 +71,23 @@ makeTextFieldCursorWithSelection :: Int -> Int -> Text -> Maybe TextFieldCursor makeTextFieldCursorWithSelection x y t = do - let ls - -- This is safe because 'splitOn' always returns a nonempty list. - = NE.fromList $ T.split (== '\n') t + ls <- NE.nonEmpty $ T.split (== '\n') t guard (x >= 0) guard (x < NE.length ls) - nec <- - makeNonEmptyCursorWithSelection - -- This is safe because we already checked that it would work above - (makeTextCursorWithSelection y) - x - ls + nec <- makeNonEmptyCursorWithSelection (makeTextCursorWithSelection y) x ls void $ nonEmptyCursorCurrent nec + -- This is safe because we already checked that it would work above pure $ TextFieldCursor (nec & nonEmptyCursorElemL %~ fromJust) rebuildTextFieldCursorLines :: TextFieldCursor -> NonEmpty Text -rebuildTextFieldCursorLines = - rebuildNonEmptyCursor rebuildTextCursor . textFieldCursorNonEmpty +rebuildTextFieldCursorLines = rebuildNonEmptyCursor rebuildTextCursor . textFieldCursorNonEmpty rebuildTextFieldCursor :: TextFieldCursor -> Text -rebuildTextFieldCursor = - T.intercalate "\n" . NE.toList . rebuildTextFieldCursorLines +rebuildTextFieldCursor = T.intercalate "\n" . NE.toList . rebuildTextFieldCursorLines emptyTextFieldCursor :: TextFieldCursor emptyTextFieldCursor = - TextFieldCursor - {textFieldCursorNonEmpty = singletonNonEmptyCursor emptyTextCursor} + TextFieldCursor {textFieldCursorNonEmpty = singletonNonEmptyCursor emptyTextCursor} nullTextFieldCursor :: TextFieldCursor -> Bool nullTextFieldCursor = (== emptyTextFieldCursor) @@ -117,8 +97,7 @@ ( nonEmptyCursorSelection $ textFieldCursorNonEmpty tfc , textCursorIndex $ textFieldCursorNonEmpty tfc ^. nonEmptyCursorElemL) -textFieldCursorNonEmptyCursorL :: - Lens' TextFieldCursor (NonEmptyCursor TextCursor Text) +textFieldCursorNonEmptyCursorL :: Lens' TextFieldCursor (NonEmptyCursor TextCursor Text) textFieldCursorNonEmptyCursorL = lens textFieldCursorNonEmpty $ \tfc lec -> tfc {textFieldCursorNonEmpty = lec} @@ -127,13 +106,11 @@ textFieldCursorSelectPrevLine :: TextFieldCursor -> Maybe TextFieldCursor textFieldCursorSelectPrevLine = - moveMWhileKeepingSelection $ - nonEmptyCursorSelectPrev rebuildTextCursor unsafeMakeTextCursor + moveMWhileKeepingSelection $ nonEmptyCursorSelectPrev rebuildTextCursor unsafeMakeTextCursor textFieldCursorSelectNextLine :: TextFieldCursor -> Maybe TextFieldCursor textFieldCursorSelectNextLine = - moveMWhileKeepingSelection $ - nonEmptyCursorSelectNext rebuildTextCursor unsafeMakeTextCursor + moveMWhileKeepingSelection $ nonEmptyCursorSelectNext rebuildTextCursor unsafeMakeTextCursor moveMWhileKeepingSelection :: (NonEmptyCursor TextCursor Text -> Maybe (NonEmptyCursor TextCursor Text)) @@ -147,13 +124,11 @@ textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor textFieldCursorSelectFirstLine = - moveWhileKeepingSelection $ - nonEmptyCursorSelectFirst rebuildTextCursor unsafeMakeTextCursor + moveWhileKeepingSelection $ nonEmptyCursorSelectFirst rebuildTextCursor unsafeMakeTextCursor textFieldCursorSelectLastLine :: TextFieldCursor -> TextFieldCursor textFieldCursorSelectLastLine = - moveWhileKeepingSelection $ - nonEmptyCursorSelectLast rebuildTextCursor unsafeMakeTextCursor + moveWhileKeepingSelection $ nonEmptyCursorSelectLast rebuildTextCursor unsafeMakeTextCursor moveWhileKeepingSelection :: (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text) @@ -172,28 +147,38 @@ textFieldCursorSelectNextChar = textFieldCursorSelectedL textCursorSelectNext textFieldCursorIndexOnLine :: TextFieldCursor -> Int -textFieldCursorIndexOnLine tfc = - textCursorIndex $ tfc ^. textFieldCursorSelectedL +textFieldCursorIndexOnLine tfc = textCursorIndex $ tfc ^. textFieldCursorSelectedL textFieldCursorSelectIndexOnLine :: Int -> TextFieldCursor -> TextFieldCursor -textFieldCursorSelectIndexOnLine ix_ = - textFieldCursorSelectedL %~ textCursorSelectIndex ix_ +textFieldCursorSelectIndexOnLine ix_ = textFieldCursorSelectedL %~ textCursorSelectIndex ix_ -textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> TextFieldCursor +-- | +-- +-- returns 'Nothing' when given unsafe characters. +textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor textFieldCursorInsertChar c mtfc = case c of - '\n' -> textFieldCursorInsertNewline mtfc - _ -> - (fromMaybe emptyTextFieldCursor mtfc) & - textFieldCursorSelectedL %~ (fromJust . textCursorInsert c) + '\n' -> Just $ textFieldCursorInsertNewline mtfc + _ + | isSafeChar c -> + Just $ + (fromMaybe emptyTextFieldCursor mtfc) & + textFieldCursorSelectedL %~ (fromJust . textCursorInsert c) + | otherwise -> Nothing -textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> TextFieldCursor +-- | +-- +-- returns 'Nothing' when given unsafe characters. +textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> Maybe TextFieldCursor textFieldCursorAppendChar c mtfc = case c of - '\n' -> textFieldCursorAppendNewline mtfc - _ -> - (fromMaybe emptyTextFieldCursor mtfc) & - textFieldCursorSelectedL %~ (fromJust . textCursorAppend c) + '\n' -> Just $ textFieldCursorAppendNewline mtfc + _ + | isSafeChar c -> + Just $ + (fromMaybe emptyTextFieldCursor mtfc) & + textFieldCursorSelectedL %~ (fromJust . textCursorAppend c) + | otherwise -> Nothing textFieldCursorInsertNewline :: Maybe TextFieldCursor -> TextFieldCursor textFieldCursorInsertNewline mtfc = @@ -219,8 +204,7 @@ , nonEmptyCursorNext = rebuildTextCursor tc2 : nonEmptyCursorNext }) -textFieldCursorRemove :: - TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor) +textFieldCursorRemove :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor) textFieldCursorRemove tfc = if nullTextFieldCursor tfc then Just Deleted @@ -228,8 +212,7 @@ textFieldCursorNonEmptyCursorL (\lec@NonEmptyCursor {..} -> case textCursorRemove nonEmptyCursorCurrent of - Just (Updated ctc) -> - Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc + Just (Updated ctc) -> Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc _ -> case nonEmptyCursorPrev of [] -> Nothing @@ -239,14 +222,11 @@ lec { nonEmptyCursorPrev = pls , nonEmptyCursorCurrent = - textCursorCombine - (unsafeMakeTextCursor pl) - nonEmptyCursorCurrent + textCursorCombine (unsafeMakeTextCursor pl) nonEmptyCursorCurrent }) tfc -textFieldCursorDelete :: - TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor) +textFieldCursorDelete :: TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor) textFieldCursorDelete tfc = if nullTextFieldCursor tfc then Just Deleted @@ -254,8 +234,7 @@ textFieldCursorNonEmptyCursorL (\lec@NonEmptyCursor {..} -> case textCursorDelete nonEmptyCursorCurrent of - Just (Updated ctc) -> - Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc + Just (Updated ctc) -> Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc _ -> case nonEmptyCursorNext of [] -> Nothing @@ -264,16 +243,13 @@ Updated $ lec { nonEmptyCursorCurrent = - textCursorCombine - nonEmptyCursorCurrent - (unsafeMakeTextCursor pl) + textCursorCombine nonEmptyCursorCurrent (unsafeMakeTextCursor pl) , nonEmptyCursorNext = pls }) tfc textFieldCursorSelectStartOfLine :: TextFieldCursor -> TextFieldCursor -textFieldCursorSelectStartOfLine = - textFieldCursorSelectedL %~ textCursorSelectStart +textFieldCursorSelectStartOfLine = textFieldCursorSelectedL %~ textCursorSelectStart textFieldCursorSelectEndOfLine :: TextFieldCursor -> TextFieldCursor textFieldCursorSelectEndOfLine = textFieldCursorSelectedL %~ textCursorSelectEnd diff --git a/src/Cursor/Types.hs b/src/Cursor/Types.hs --- a/src/Cursor/Types.hs +++ b/src/Cursor/Types.hs @@ -5,6 +5,7 @@ import GHC.Generics (Generic) +import qualified Data.Text.Internal as T import Data.Validity import Data.Functor.Compose @@ -13,6 +14,9 @@ import Lens.Micro +isSafeChar :: Char -> Bool +isSafeChar c = T.safe c == c + data DeleteOrUpdate a = Deleted | Updated a @@ -35,8 +39,7 @@ Updated a <|> _ = Updated a Deleted <|> doua = doua -joinDeletes :: - Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a) -> DeleteOrUpdate a +joinDeletes :: Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a) -> DeleteOrUpdate a joinDeletes m1 m2 = case (m1, m2) of (Nothing, Nothing) -> Deleted @@ -56,16 +59,11 @@ (Just a, _, _) -> a joinPossibleDeletes :: - Maybe (DeleteOrUpdate a) - -> Maybe (DeleteOrUpdate a) - -> Maybe (DeleteOrUpdate a) + Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a) joinPossibleDeletes d1 d2 = getCompose $ Compose d1 <|> Compose d2 focusPossibleDeleteOrUpdate :: - Lens' b a - -> (a -> Maybe (DeleteOrUpdate a)) - -> b - -> Maybe (DeleteOrUpdate b) + Lens' b a -> (a -> Maybe (DeleteOrUpdate a)) -> b -> Maybe (DeleteOrUpdate b) focusPossibleDeleteOrUpdate l func = getCompose . l (Compose . func) dullMDelete :: Maybe (DeleteOrUpdate a) -> Maybe a