calamity-commands 0.3.0.0 → 0.4.0.0

raw patch · 16 files changed

+187/−201 lines, 16 filesdep +opticsdep −generic-lensdep −lensPVP ok

version bump matches the API change (PVP)

Dependencies added: optics

Dependencies removed: generic-lens, lens

API changes (from Hackage documentation)

Files

• CalamityCommands/AliasType.hs +6/−9
• CalamityCommands/Check.hs +18/−21
• CalamityCommands/Command.hs +19/−20
• CalamityCommands/CommandUtils.hs +1/−4
• CalamityCommands/Context.hs +5/−4
• CalamityCommands/Dsl.hs +0/−2
• CalamityCommands/Error.hs +21/−22
• CalamityCommands/Group.hs +34/−37
• CalamityCommands/Handler.hs +22/−21
• CalamityCommands/Help.hs +3/−6
• CalamityCommands/Internal/Utils.hs +24/−24
• CalamityCommands/ParameterInfo.hs +13/−11
• CalamityCommands/Parser.hs +7/−9
• CalamityCommands/Utils.hs +2/−7
• ChangeLog.md +9/−0
• calamity-commands.cabal +3/−4

@@ -1,15 +1,12 @@ -- | Named boolean for determining if something is an alias or not-module CalamityCommands.AliasType-  ( AliasType (..),-  )-where+module CalamityCommands.AliasType (+  AliasType (..),+) where -import GHC.Generics (Generic)-import TextShow (TextShow)-import qualified TextShow.Generic as TSG+import qualified TextShow  data AliasType   = Alias   | Original-  deriving (Eq, Enum, Show, Generic)-  deriving (TextShow) via TSG.FromGeneric AliasType+  deriving (Eq, Enum, Show)+  deriving (TextShow.TextShow) via TextShow.FromStringShow AliasType

@@ -1,23 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | Command invokation preconditions module CalamityCommands.Check (-    Check (..),-    buildCheck,-    buildCheckPure,-    runCheck,+  Check (..),+  buildCheck,+  buildCheckPure,+  runCheck, ) where  import CalamityCommands.Error import CalamityCommands.Internal.RunIntoM import CalamityCommands.Internal.Utils--import Control.Lens hiding (Context, (<.>))--import Data.Generics.Labels () import Data.Maybe import qualified Data.Text as T--import GHC.Generics-+import Optics import qualified Polysemy as P  {- | A check for a command.@@ -25,22 +21,23 @@  Every check for a command must return Nothing for the command to be run. -} data Check m c = MkCheck-    { -- | The name of the check.-      name :: T.Text-    , -- | The callback for the check, returns Nothing if it passes, otherwise-      -- returns the reason for it not passing.-      callback :: c -> m (Maybe T.Text)-    }-    deriving (Generic)+  { -- | The name of the check.+    name :: T.Text+  , -- | The callback for the check, returns Nothing if it passes, otherwise+    -- returns the reason for it not passing.+    callback :: c -> m (Maybe T.Text)+  } +$(makeFieldLabelsNoPrefix ''Check)+ {- | Given the name of a check and a callback in the 'P.Sem' monad, build a check  by transforming the Polysemy action into an @m@ action. -} buildCheck :: (Monad m, P.Member (P.Final m) r) => T.Text -> (c -> P.Sem r (Maybe T.Text)) -> P.Sem r (Check m c) buildCheck name cb = do-    cb' <- bindSemToM cb-    let cb'' = fromMaybe (Just "failed internally") <.> cb'-    pure $ MkCheck name cb''+  cb' <- bindSemToM cb+  let cb'' = fromMaybe (Just "failed internally") <.> cb'+  pure $ MkCheck name cb''  -- | Given the name of a check and a pure callback function, build a check. buildCheckPure :: Monad m => T.Text -> (c -> Maybe T.Text) -> Check m c

@@ -1,4 +1,4 @@-{-# LANGUAGE NoPolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}  -- | Commands and stuff module CalamityCommands.Command (Command (..)) where@@ -7,18 +7,13 @@ import CalamityCommands.Error import CalamityCommands.Group import CalamityCommands.ParameterInfo--import Control.Lens hiding (Context, (<.>))- import Data.Kind (Type) import Data.List.NonEmpty (NonEmpty)-import Data.Text as T--import GHC.Generics- import qualified Data.List.NonEmpty as NE-import TextShow-import qualified TextShow.Generic as TSG+import Data.Text as T+import Optics+import qualified TextShow+import TextShow.TH (deriveTextShow)  -- | A command, paremeterised over its context data Command (m :: Type -> Type) (c :: Type) (a :: Type) = forall p.@@ -41,6 +36,8 @@     callback :: (c, p) -> m (Either T.Text a)   } +$(makeFieldLabelsNoPrefix ''Command)+ data CommandS = CommandS   { names :: NonEmpty T.Text   , params :: [ParameterInfo]@@ -48,25 +45,27 @@   , checks :: [T.Text]   , hidden :: Bool   }-  deriving (Generic, Show)-  deriving (TextShow) via TSG.FromGeneric CommandS+  deriving (Show)  instance Show (Command m c a) where-  showsPrec d Command{names, params, parent, checks, hidden} =+  showsPrec d Command {names, params, parent, checks, hidden} =     showsPrec d $       CommandS         names         params-        (NE.head <$> parent ^? _Just . #names)-        (checks ^.. traverse . #name)+        (NE.head <$> parent ^? _Just % #names)+        (checks ^.. traversed % #name)         hidden -instance TextShow (Command m c a) where-  showbPrec d Command{names, params, parent, checks, hidden} =-    showbPrec d $+$(deriveTextShow ''CommandS)++instance TextShow.TextShow (Command m c a) where+  showbPrec d Command {names, params, parent, checks, hidden} =+    TextShow.showbPrec d $       CommandS         names         params-        (NE.head <$> parent ^? _Just . #names)-        (checks ^.. traverse . #name)+        (NE.head <$> parent ^? _Just % #names)+        (checks ^.. traversed % #name)         hidden+

@@ -22,17 +22,14 @@ import CalamityCommands.Internal.Utils import CalamityCommands.ParameterInfo import CalamityCommands.Parser--import Control.Lens hiding (Context, (<.>))+import Optics import Control.Monad- import Data.Foldable import Data.Kind import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe import qualified Data.Text as S- import qualified Polysemy as P import qualified Polysemy.Error as P import qualified Polysemy.Fail as P

@@ -9,12 +9,11 @@   useBasicContext, ) where +import CalamityCommands.Command import qualified Data.Text as T-import GHC.Generics (Generic)+import Optics.TH import qualified Polysemy as P -import CalamityCommands.Command- class CommandContext m c a | c -> m, c -> a where   -- | The prefix that was used to invoke the command   ctxPrefix :: c -> T.Text@@ -44,7 +43,7 @@   , bcCommand :: Command m (BasicContext m a) a   , bcUnparsedParams :: T.Text   }-  deriving (Show, Generic)+  deriving (Show)  instance CommandContext m (BasicContext m a) a where   ctxPrefix = bcPrefix@@ -58,3 +57,5 @@     ( \case         ConstructContext (pre, cmd, up) _ -> pure . Just $ BasicContext pre cmd up     )++$(makeFieldLabelsNoPrefix ''BasicContext)

@@ -33,10 +33,8 @@ import CalamityCommands.Handler import CalamityCommands.ParameterInfo import CalamityCommands.Internal.LocalWriter- import qualified Data.HashMap.Lazy as LH import qualified Data.Text as T- import Data.List.NonEmpty (NonEmpty (..)) import qualified Polysemy as P import qualified Polysemy.Fail as P

@@ -1,28 +1,27 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | Command errors module CalamityCommands.Error (CommandError (..)) where  import qualified Data.Text as T--import GHC.Generics--import TextShow-import qualified TextShow.Generic as TSG+import TextShow.TH (deriveTextShow)  data CommandError-    = ParseError-        T.Text-        -- ^ The type of the parser-        T.Text-        -- ^ The reason that parsing failed-    | CheckError-        T.Text-        -- ^ The name of the check that failed-        T.Text-        -- ^ The reason for the check failing-    | InvokeError-        T.Text-        -- ^ The name of the command that failed-        T.Text-        -- ^ The reason for failing-    deriving (Show, Generic)-    deriving (TextShow) via TSG.FromGeneric CommandError+  = ParseError+      T.Text+      -- ^ The type of the parser+      T.Text+      -- ^ The reason that parsing failed+  | CheckError+      T.Text+      -- ^ The name of the check that failed+      T.Text+      -- ^ The reason for the check failing+  | InvokeError+      T.Text+      -- ^ The name of the command that failed+      T.Text+      -- ^ The reason for failing+  deriving (Show)++$(deriveTextShow ''CommandError)

@@ -1,4 +1,4 @@-{-# LANGUAGE NoPolyKinds #-}+{-# LANGUAGE TemplateHaskell #-}  -- | Command groups module CalamityCommands.Group (Group (..)) where@@ -6,49 +6,46 @@ import CalamityCommands.AliasType import CalamityCommands.Check import {-# SOURCE #-} CalamityCommands.Command--import Control.Lens hiding (Context, (<.>))- import qualified Data.HashMap.Lazy as LH-import qualified Data.Text as T--import GHC.Generics- import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NE-import TextShow-import qualified TextShow.Generic as TSG+import qualified Data.Text as T+import Optics+import qualified TextShow+import TextShow.TH (deriveTextShow)  -- | A group of commands data Group m c a = Group-    { names :: NonEmpty T.Text-    , parent :: Maybe (Group m c a)-    , hidden :: Bool-    , -- | Any child commands of this group-      commands :: LH.HashMap T.Text (Command m c a, AliasType)-    , -- | Any child groups of this group-      children :: LH.HashMap T.Text (Group m c a, AliasType)-    , -- | A function producing the \'help\' for the group-      help :: c -> T.Text-    , -- | A list of checks that must pass-      checks :: [Check m c]-    }-    deriving (Generic)+  { names :: NonEmpty T.Text+  , parent :: Maybe (Group m c a)+  , hidden :: Bool+  , -- | Any child commands of this group+    commands :: LH.HashMap T.Text (Command m c a, AliasType)+  , -- | Any child groups of this group+    children :: LH.HashMap T.Text (Group m c a, AliasType)+  , -- | A function producing the \'help\' for the group+    help :: c -> T.Text+  , -- | A list of checks that must pass+    checks :: [Check m c]+  } +$(makeFieldLabelsNoPrefix ''Group)+ data GroupS m c a = GroupS-    { names :: NonEmpty T.Text-    , parent :: Maybe T.Text-    , commands :: [(T.Text, (Command m c a, AliasType))]-    , children :: [(T.Text, (Group m c a, AliasType))]-    , hidden :: Bool-    }-    deriving (Generic, Show)-    deriving (TextShow) via TSG.FromGeneric (GroupS m c a)+  { names :: NonEmpty T.Text+  , parent :: Maybe T.Text+  , commands :: [(T.Text, (Command m c a, AliasType))]+  , children :: [(T.Text, (Group m c a, AliasType))]+  , hidden :: Bool+  }+  deriving (Show) -instance Show (Group m c a) where-    showsPrec d Group{names, parent, commands, children, hidden} =-        showsPrec d $ GroupS names (NE.head <$> parent ^? _Just . #names) (LH.toList commands) (LH.toList children) hidden+instance (Show a, Show c) => Show (Group m c a) where+  showsPrec d Group {names, parent, commands, children, hidden} =+    showsPrec d $ GroupS names (NE.head <$> parent ^? _Just % #names) (LH.toList commands) (LH.toList children) hidden -instance TextShow (Group m c a) where-    showbPrec d Group{names, parent, commands, children, hidden} =-      showbPrec d $ GroupS names (NE.head <$> parent ^? _Just . #names) (LH.toList commands) (LH.toList children) hidden+$(deriveTextShow ''GroupS)++instance (TextShow.TextShow a, TextShow.TextShow c) => TextShow.TextShow (Group m c a) where+  showbPrec d Group {names, parent, commands, children, hidden} =+    TextShow.showbPrec d $ GroupS names (NE.head <$> parent ^? _Just % #names) (LH.toList commands) (LH.toList children) hidden

@@ -1,35 +1,36 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | A command handler module CalamityCommands.Handler (CommandHandler (..)) where  import CalamityCommands.AliasType import CalamityCommands.Command import CalamityCommands.Group- import qualified Data.HashMap.Lazy as LH import qualified Data.Text as S--import GHC.Generics--import TextShow-import qualified TextShow.Generic as TSG+import Optics.TH+import qualified TextShow+import TextShow.TH (deriveTextShow)  data CommandHandler m c a = CommandHandler-    { -- | Top level groups-      groups :: LH.HashMap S.Text (Group m c a, AliasType)-    , -- | Top level commands-      commands :: LH.HashMap S.Text (Command m c a, AliasType)-    }-    deriving (Generic)+  { -- | Top level groups+    groups :: LH.HashMap S.Text (Group m c a, AliasType)+  , -- | Top level commands+    commands :: LH.HashMap S.Text (Command m c a, AliasType)+  }  data CommandHandlerS m c a = CommandHandlerS-    { groups :: [(S.Text, (Group m c a, AliasType))]-    , commands :: [(S.Text, (Command m c a, AliasType))]-    }-    deriving (Show, Generic)-    deriving (TextShow) via TSG.FromGeneric (CommandHandlerS m c a)+  { groups :: [(S.Text, (Group m c a, AliasType))]+  , commands :: [(S.Text, (Command m c a, AliasType))]+  }+  deriving (Show) -instance Show (CommandHandler m c a) where-    showsPrec d CommandHandler{groups, commands} = showsPrec d $ CommandHandlerS (LH.toList groups) (LH.toList commands)+instance (Show c, Show a) => Show (CommandHandler m c a) where+  showsPrec d CommandHandler {groups, commands} = showsPrec d $ CommandHandlerS (LH.toList groups) (LH.toList commands) -instance TextShow (CommandHandler m c a) where-    showbPrec d CommandHandler{groups, commands} = showbPrec d $ CommandHandlerS (LH.toList groups) (LH.toList commands)+$(deriveTextShow ''CommandHandlerS)++instance (TextShow.TextShow c, TextShow.TextShow a) => TextShow.TextShow (CommandHandler m c a) where+  showbPrec d CommandHandler {groups, commands} = TextShow.showbPrec d $ CommandHandlerS (LH.toList groups) (LH.toList commands)++$(makeFieldLabelsNoPrefix ''CommandHandler)

@@ -14,16 +14,13 @@ import CalamityCommands.Handler import CalamityCommands.ParameterInfo import CalamityCommands.Internal.LocalWriter- import Control.Applicative-import Control.Lens hiding (Context (..))-+import Optics import qualified Data.HashMap.Lazy as LH import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe) import qualified Data.Text as T- import qualified Polysemy as P import qualified Polysemy.Fail as P import qualified Polysemy.Reader as P@@ -100,7 +97,7 @@   path' = T.unwords $ groupPath grp   groups = onlyVisibleG . onlyOriginals . LH.elems $ grp ^. #children   commands = onlyVisibleC . onlyOriginals . LH.elems $ grp ^. #commands-  groupsFmt = map formatWithAliases (groups ^.. traverse . #names)+  groupsFmt = map formatWithAliases (groups ^.. traversed % #names)   groupsMsg =     if null groups       then ""@@ -125,7 +122,7 @@  where   groups = onlyVisibleG . onlyOriginals . LH.elems $ handler ^. #groups   commands = onlyVisibleC . onlyOriginals . LH.elems $ handler ^. #commands-  groupsFmt = map formatWithAliases (groups ^.. traverse . #names)+  groupsFmt = map formatWithAliases (groups ^.. traversed % #names)   groupsMsg =     if null groups       then ""

@@ -1,27 +1,27 @@ {-# OPTIONS_GHC -Wno-orphans #-}  -- | Internal utilities and instances-module CalamityCommands.Internal.Utils-    ( -- whileMFinalIO-    -- , untilJustFinalIO-     whenJust-    , whenM-    , unlessM-    , lastMaybe-    , leftToMaybe-    , rightToMaybe-    , justToEither-    , mapLeft-    , (<<$>>)-    , (<<*>>)-    , (<.>)-     ) where+module CalamityCommands.Internal.Utils (+  -- whileMFinalIO+  -- , untilJustFinalIO+  whenJust,+  whenM,+  unlessM,+  lastMaybe,+  leftToMaybe,+  rightToMaybe,+  justToEither,+  mapLeft,+  (<<$>>),+  (<<*>>),+  (<.>),+) where  -- import           CalamityCommands.Internal.RunIntoIO -import           Control.Applicative+import Control.Applicative -import           Data.Semigroup        ( Last(..) )+import Data.Semigroup (Last (..))  -- import qualified Polysemy              as P @@ -61,9 +61,10 @@ whenJust = flip $ maybe (pure ())  whenM :: Monad m => m Bool -> m () -> m ()-whenM p m = p >>= \case-  True  -> m-  False -> pure ()+whenM p m =+  p >>= \case+    True -> m+    False -> pure ()  unlessM :: Monad m => m Bool -> m () -> m () unlessM = whenM . (not <$>)@@ -77,15 +78,15 @@  leftToMaybe :: Either e a -> Maybe e leftToMaybe (Left x) = Just x-leftToMaybe _        = Nothing+leftToMaybe _ = Nothing  rightToMaybe :: Either e a -> Maybe a rightToMaybe (Right x) = Just x-rightToMaybe _         = Nothing+rightToMaybe _ = Nothing  justToEither :: Maybe e -> Either e () justToEither (Just x) = Left x-justToEither _        = Right ()+justToEither _ = Right ()  (<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) (<<$>>) = fmap . fmap@@ -101,4 +102,3 @@ (<.>) f g x = f <$> g x  infixl 4 <.>-

@@ -1,19 +1,21 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | Parameter info for a command module CalamityCommands.ParameterInfo (-    ParameterInfo (..),+  ParameterInfo (..), ) where  import qualified Data.Text as S import Data.Typeable--import GHC.Generics (Generic)-import TextShow-import qualified TextShow.Generic as TSG+import Optics.TH (makeFieldLabelsNoPrefix)+import TextShow.TH (deriveTextShow)  data ParameterInfo = ParameterInfo-    { name :: Maybe S.Text-    , type_ :: TypeRep-    , typeDescription :: S.Text-    }-    deriving (Show, Generic)-    deriving (TextShow) via TSG.FromGeneric ParameterInfo+  { name :: Maybe S.Text+  , type_ :: TypeRep+  , typeDescription :: S.Text+  }+  deriving (Show)++$(deriveTextShow ''ParameterInfo)+$(makeFieldLabelsNoPrefix ''ParameterInfo)

@@ -1,3 +1,5 @@+{-# LANGUAGE TemplateHaskell #-}+ -- | Something that can parse user input module CalamityCommands.Parser (   ParameterParser (..),@@ -15,11 +17,9 @@  import CalamityCommands.ParameterInfo -import Control.Lens hiding (Context) import Control.Monad-+import Optics import Data.Char (isSpace)-import Data.Generics.Labels () import Data.Kind import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (fromMaybe)@@ -27,15 +27,11 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as L import Data.Typeable--import GHC.Generics (Generic) import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)- import qualified Polysemy as P import qualified Polysemy.Error as P import qualified Polysemy.Reader as P import qualified Polysemy.State as P- import Numeric.Natural (Natural) import Text.Megaparsec hiding (parse) import Text.Megaparsec.Char@@ -57,8 +53,10 @@   , -- | The input message ot parse     msg :: T.Text   }-  deriving (Show, Generic)+  deriving (Show) +$(makeFieldLabelsNoPrefix ''ParserState)+ -- | type ParserEffs c r =   ( P.State ParserState@@ -129,7 +127,7 @@   res <- P.raise . P.raise $ runParserT (skipN (s ^. #off) *> trackOffsets (space *> m)) "" (s ^. #msg)   case res of     Right (a, offset) -> do-      P.modify (#off +~ offset)+      P.modify (#off %~ (+ offset))       pure a     Left s -> P.throw (n, T.pack $ errorBundlePretty s) 

@@ -19,21 +19,16 @@ import CalamityCommands.Handler import CalamityCommands.Internal.LocalWriter import CalamityCommands.ParsePrefix--import Control.Lens hiding (Context) import Control.Monad.Fix (MonadFix)- import Data.Char (isSpace) import qualified Data.HashMap.Lazy as LH import qualified Data.Text as T--import GHC.Generics (Generic)- import qualified Polysemy as P import qualified Polysemy.Error as P import qualified Polysemy.Fixpoint as P import qualified Polysemy.Reader as P import qualified Polysemy.Tagged as P+import Optics  mapLeft :: (e -> e') -> Either e a -> Either e' a mapLeft f (Left x) = Left $ f x@@ -43,7 +38,7 @@   = NoContext   | NotFound [T.Text]   | CommandInvokeError c CommandError-  deriving (Show, Generic)+  deriving (Show)  {- | Manages parsing messages and handling commands for a CommandHandler. 

@@ -1,5 +1,14 @@ # Changelog for Calamity Commands +## 0.5.0.0+++ Replaced lens with optics internally, you should use optics for field labels now.++ Generic instances have been removed from library data types.++## 0.3.0.0+++ DSL commands no longer use a concrete effect list prefix.+ ## 0.2.0.0  + Remove all usages of lazy Text (except from typeclass instances)

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           calamity-commands-version:        0.3.0.0+version:        0.4.0.0 synopsis:       A library for declaring, parsing, and invoking text-input based commands description:    Please see the README on GitHub at <https://github.com/simmsb/calamity#readme> category:       Utils@@ -18,7 +18,7 @@ license-file:   LICENSE build-type:     Simple tested-with:-    GHC == 8.10.4+    GHC == 8.10.7, GHC == 9.2.2 extra-source-files:     README.md     ChangeLog.md@@ -104,8 +104,7 @@   ghc-options: -fplugin=Polysemy.Plugin -funbox-strict-fields -Wall -fno-warn-name-shadowing   build-depends:       base >=4.13 && <5-    , generic-lens >=2.0 && <3-    , lens >=4.18 && <6+    , optics >=0.4.1 && <0.5     , megaparsec >=8 && <10     , polysemy >=1.5 && <2     , polysemy-plugin >=0.3 && <0.5