diff options
Diffstat (limited to 'users/grfn/xanthous/src')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Game/Prompt.hs | 5 | ||||
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Util.hs | 34 |
2 files changed, 37 insertions, 2 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs index 30b5fe7545e0..fa4c3903deb1 100644 --- a/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs +++ b/users/grfn/xanthous/src/Xanthous/Game/Prompt.hs @@ -28,7 +28,8 @@ import Brick.Widgets.Edit (Editor, editorText, getEditContents) import Test.QuickCheck import Test.QuickCheck.Arbitrary.Generic -------------------------------------------------------------------------------- -import Xanthous.Util (smallestNotIn) +-------------------------------------------------------------------------------- +import Xanthous.Util (smallestNotIn, AlphaChar (..)) import Xanthous.Data (Direction, Position) import Xanthous.Data.App (ResourceName) import qualified Xanthous.Data.App as Resource @@ -175,7 +176,7 @@ mkMenuItems :: (MonoFoldable f, Element f ~ (Char, MenuOption a)) -> Map Char (MenuOption a) mkMenuItems = flip foldl' mempty $ \items (chr, option) -> let chr' = if has (ix chr) items - then smallestNotIn $ keys items + then getAlphaChar . smallestNotIn . map AlphaChar $ keys items else chr in items & at chr' ?~ option diff --git a/users/grfn/xanthous/src/Xanthous/Util.hs b/users/grfn/xanthous/src/Xanthous/Util.hs index d3e8cdc30138..2f9606b29c50 100644 --- a/users/grfn/xanthous/src/Xanthous/Util.hs +++ b/users/grfn/xanthous/src/Xanthous/Util.hs @@ -38,6 +38,9 @@ module Xanthous.Util -- * Type-level programming utils , KnownBool(..) + + -- * + , AlphaChar(..) ) where -------------------------------------------------------------------------------- import Xanthous.Prelude hiding (foldr) @@ -299,3 +302,34 @@ modifyK k = get >>= k >>= put -- @@ modifyKL :: MonadState s m => LensLike m s s a b -> (a -> m b) -> m () modifyKL l k = get >>= traverseOf l k >>= put + +-------------------------------------------------------------------------------- + +-- | A newtype wrapper around 'Char' whose 'Enum' and 'Bounded' instances only +-- include the characters @[a-zA-Z]@ +-- +-- >>> succ (AlphaChar 'z') +-- 'A' +newtype AlphaChar = AlphaChar { getAlphaChar :: Char } + deriving stock Show + deriving (Eq, Ord) via Char + +instance Enum AlphaChar where + toEnum n + | between 0 25 n + = AlphaChar . toEnum $ n + fromEnum 'a' + | between 26 51 n + = AlphaChar . toEnum $ n - 26 + fromEnum 'A' + | otherwise + = error $ "Tag " <> show n <> " out of range [0, 51] for enum AlphaChar" + fromEnum (AlphaChar chr) + | between 'a' 'z' chr + = fromEnum chr - fromEnum 'a' + | between 'A' 'Z' chr + = fromEnum chr - fromEnum 'A' + | otherwise + = error $ "Invalid value for alpha char: " <> show chr + +instance Bounded AlphaChar where + minBound = AlphaChar 'a' + maxBound = AlphaChar 'Z' |