From c3b25cb4f165f1b0449b1b53fabefb161c17e4eb Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Tue, 2 Aug 2022 18:56:55 +0100 Subject: [PATCH 01/53] tidied some code but most importantly fixed the issue with subtraction that may have effected other binary operators --- src/Tablebot/Plugins/Roll/Dice/DiceData.hs | 59 +++++++++++++++---- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 49 +++++++-------- src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs | 52 ++++++++++------ src/Tablebot/Plugins/Roll/Dice/DiceStats.hs | 38 ++++++------ src/Tablebot/Plugins/Roll/Plugin.hs | 2 +- 5 files changed, 128 insertions(+), 72 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs index bb9d2e9..a6c10ae 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE PatternSynonyms #-} + -- | -- Module : Tablebot.Plugins.Roll.Dice.DiceData -- Description : Data structures for dice and other expressions. @@ -45,9 +47,6 @@ data Program = Program [Statement] (Either ListValues Expr) deriving (Show) data ArgValue = AVExpr Expr | AVListValues ListValues deriving (Show) --- | Alias for `MiscData` that returns a `ListValues`. -type ListValuesMisc = MiscData ListValues - -- | The type for list values. data ListValues = -- | Represents `N#B`, where N is a NumBase (numbers, parentheses) and B is a Base (numbase or dice value) @@ -59,7 +58,7 @@ data ListValues | -- | A variable that has been defined elsewhere. LVVar Text | -- | A misc list values expression. - ListValuesMisc ListValuesMisc + ListValuesMisc (MiscData ListValues) deriving (Show) -- | The type for basic list values (that can be used as is for custom dice). @@ -71,18 +70,49 @@ data ListValues data ListValuesBase = LVBParen (Paren ListValues) | LVBList [Expr] deriving (Show) --- | Alias for `MiscData` that returns an `Expr`. -type ExprMisc = MiscData Expr +-- | The type for a binary operator between one or more `sub` values +data BinOp sub typ where + BinOp :: Operation typ => sub -> [(typ, sub)] -> BinOp sub typ + +deriving instance (Show sub, Show typ) => Show (BinOp sub typ) + +-- | Convenience pattern for the empty list. +pattern SingBinOp :: (Operation typ) => sub -> BinOp sub typ +pattern SingBinOp a <- + BinOp a [] + where + SingBinOp a = BinOp a [] + +-- | The type class that means we can get an operation on integers from a value. +class Operation a where + getOperation :: a -> (forall n. Integral n => n -> n -> n) --- | The type of the top level expression. Represents one of addition, --- subtraction, or a single term; or some misc expression statement. -data Expr = ExprMisc ExprMisc | Add Term Expr | Sub Term Expr | NoExpr Term +-- | The type of the top level expression. +-- +-- Represents either a misc expression or additive operations between terms. +data Expr = ExprMisc (MiscData Expr) | Expr (BinOp Term ExprType) deriving (Show) --- | The type representing multiplication, division, or a single negated term. -data Term = Multi Negation Term | Div Negation Term | NoTerm Negation +-- | The type of the additive expression, either addition or subtraction. +data ExprType = Add | Sub + deriving (Show, Eq) + +instance Operation ExprType where + getOperation Sub = (-) + getOperation Add = (+) + +-- | Represents multiplicative operations between (possible) negations. +newtype Term = Term (BinOp Negation TermType) deriving (Show) +-- | The type of the additive expression, either addition or subtraction. +data TermType = Multi | Div + deriving (Show, Eq) + +instance Operation TermType where + getOperation Multi = (*) + getOperation Div = div + -- | The type representing a possibly negated value. data Negation = Neg Expo | NoNeg Expo deriving (Show) @@ -181,11 +211,14 @@ class Converter a b where instance Converter ListValuesBase ListValues where promote = LVBase +instance (Converter a sub, Operation typ) => Converter a (BinOp sub typ) where + promote = SingBinOp . promote + instance (Converter a Term) => Converter a Expr where - promote = NoExpr . promote + promote = Expr . promote instance (Converter a Negation) => Converter a Term where - promote = NoTerm . promote + promote = Term . promote instance (Converter a Expo) => Converter a Negation where promote = NoNeg . promote diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index f276910..3a08005 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -209,21 +209,21 @@ instance IOEvalList ListValuesBase where return (vs, Nothing) evalShowL' (LVBParen (Paren lv)) = evalShowL lv -instance IOEvalList ListValuesMisc where +instance IOEvalList (MiscData ListValues) where evalShowL' (MiscVar l) = evalShowL l evalShowL' (MiscIf l) = evalShowL l -- | This type class gives a function which evaluates the value to an integer -- and a string. -class IOEval a where +class ParseShow a => IOEval a where -- | Evaluate the given item to an integer, a string representation of the -- value, and the number of RNG calls it took. If the `a` value is a dice -- value, the values of the dice should be displayed. This function adds -- the current location to the exception callstack. - evalShow :: ParseShow a => a -> ProgramStateM (Integer, Text) + evalShow :: a -> ProgramStateM (Integer, Text) evalShow a = propagateException (parseShow a) (evalShow' a) - evalShow' :: ParseShow a => a -> ProgramStateM (Integer, Text) + evalShow' :: a -> ProgramStateM (Integer, Text) instance IOEval Base where evalShow' (NBase nb) = evalShow nb @@ -388,32 +388,35 @@ evalDieOpHelpKD kd lh is = do --- Pure evaluation functions for non-dice calculations -- Was previously its own type class that wouldn't work for evaluating Base values. --- | Utility function to evaluate a binary operator. -binOpHelp :: (IOEval a, IOEval b, ParseShow a, ParseShow b) => a -> b -> Text -> (Integer -> Integer -> Integer) -> ProgramStateM (Integer, Text) -binOpHelp a b opS op = do - (a', a's) <- evalShow a - (b', b's) <- evalShow b - return (op a' b', a's <> " " <> opS <> " " <> b's) - -instance IOEval ExprMisc where +instance IOEval (MiscData Expr) where evalShow' (MiscVar l) = evalShow l evalShow' (MiscIf l) = evalShow l +instance (IOEval sub, Operation typ, ParseShow typ) => IOEval (BinOp sub typ) where + evalShow' (BinOp a tas) = foldl' foldel (evalShow a) tas + where + foldel at (typ, b) = do + (a', t) <- at + (b', t') <- evalShow b + return (getOperation typ a' b', t <> " " <> parseShow typ <> " " <> t') + instance IOEval Expr where - evalShow' (NoExpr t) = evalShow t evalShow' (ExprMisc e) = evalShow e - evalShow' (Add t e) = binOpHelp t e "+" (+) - evalShow' (Sub t e) = binOpHelp t e "-" (-) + evalShow' (Expr e) = evalShow e instance IOEval Term where - evalShow' (NoTerm f) = evalShow f - evalShow' (Multi f t) = binOpHelp f t "*" (*) - evalShow' (Div f t) = do - (f', f's) <- evalShow f - (t', t's) <- evalShow t - if t' == 0 - then evaluationException "division by zero" [parseShow t] - else return (div f' t', f's <> " / " <> t's) + evalShow' (Term (BinOp a tas)) = foldl' foldel (evalShow a) tas + where + foldel at (Div, b) = do + (a', t) <- at + (b', t') <- evalShow b + if b' == 0 + then evaluationException "division by zero" [parseShow b] + else return (getOperation Div a' b', t <> " " <> parseShow Div <> " " <> t') + foldel at (typ, b) = do + (a', t) <- at + (b', t') <- evalShow b + return (getOperation typ a' b', t <> " " <> parseShow typ <> " " <> t') instance IOEval Func where evalShow' (Func s exprs) = evaluateFunction s exprs diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs index e9462cc..4e4d04b 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs @@ -29,7 +29,7 @@ import Tablebot.Plugins.Roll.Dice.DiceFunctions import Tablebot.Utility.Parser import Tablebot.Utility.SmartParser (CanParse (..), ()) import Tablebot.Utility.Types (Parser) -import Text.Megaparsec (MonadParsec (try), choice, failure, optional, some, (), (<|>)) +import Text.Megaparsec (MonadParsec (try), choice, failure, many, optional, some, (), (<|>)) import Text.Megaparsec.Char (char, string) import Text.Megaparsec.Error (ErrorItem (Tokens)) @@ -124,18 +124,29 @@ instance (CanParse b) => CanParse (If b) where instance CanParse a => CanParse (MiscData a) where pars = (MiscVar <$> pars) <|> (MiscIf <$> pars) +instance (CanParse sub, CanParse typ, Operation typ) => CanParse (BinOp sub typ) where + pars = do + a <- pars + tas <- many parseTas + return $ BinOp a tas + where + parseTas = try $ do + t <- skipSpace *> pars + a' <- skipSpace *> pars + return (t, a') + +instance CanParse ExprType where + pars = try (char '+' $> Add) <|> try (char '-' $> Sub) + instance CanParse Expr where pars = - (ExprMisc <$> pars) - <|> ( do - t <- pars - binOpParseHelp '+' (Add t) <|> binOpParseHelp '-' (Sub t) <|> (return . NoExpr) t - ) + (ExprMisc <$> pars) <|> (Expr <$> pars) + +instance CanParse TermType where + pars = try (char '*' $> Multi) <|> try (char '/' $> Div) instance CanParse Term where - pars = do - t <- pars - binOpParseHelp '*' (Multi t) <|> binOpParseHelp '/' (Div t) <|> (return . NoTerm) t + pars = Term <$> pars instance CanParse Func where pars = functionParser integerFunctions Func <|> NoFunc <$> pars @@ -169,7 +180,7 @@ instance CanParse NumBase where (NBParen . unnest <$> pars) <|> Value <$> integer "could not parse integer" where - unnest (Paren (NoExpr (NoTerm (NoNeg (NoExpo (NoFunc (NBase (NBParen e)))))))) = e + unnest (Paren (Expr (SingBinOp (Term (SingBinOp (NoNeg (NoExpo (NoFunc (NBase (NBParen e)))))))))) = e unnest e = e instance (CanParse a) => CanParse (Paren a) where @@ -286,19 +297,26 @@ instance ParseShow a => ParseShow (MiscData a) where parseShow (MiscVar l) = parseShow l parseShow (MiscIf l) = parseShow l +instance (ParseShow sub, ParseShow typ) => ParseShow (BinOp sub typ) where + parseShow (BinOp a tas) = parseShow a <> T.concat (fmap (\(t, a') -> " " <> parseShow t <> " " <> parseShow a') tas) + +instance ParseShow ExprType where + parseShow Add = "+" + parseShow Sub = "-" + +instance ParseShow TermType where + parseShow Multi = "*" + parseShow Div = "/" + instance ParseShow Expr where - parseShow (Add t e) = parseShow t <> " + " <> parseShow e - parseShow (Sub t e) = parseShow t <> " - " <> parseShow e - parseShow (NoExpr t) = parseShow t + parseShow (Expr e) = parseShow e parseShow (ExprMisc e) = parseShow e instance ParseShow Term where - parseShow (Multi f t) = parseShow f <> " * " <> parseShow t - parseShow (Div f t) = parseShow f <> " / " <> parseShow t - parseShow (NoTerm f) = parseShow f + parseShow (Term f) = parseShow f instance ParseShow Func where - parseShow (Func s n) = funcInfoName s <> "(" <> T.intercalate "," (parseShow <$> n) <> ")" + parseShow (Func s n) = funcInfoName s <> "(" <> T.intercalate ", " (parseShow <$> n) <> ")" parseShow (NoFunc b) = parseShow b instance ParseShow Negation where diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs index 473fdd8..8b58910 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs @@ -44,14 +44,6 @@ getStats d = (modalOrder, expectation d, standardDeviation d) vals = toList d modalOrder = fst <$> sortBy (\(_, r) (_, r') -> compare r' r) vals --- | Convenience wrapper which gets the range of the given values then applies --- the function to the resultant distributions. -combineRangesBinOp :: (MonadException m, Range a, Range b, ParseShow a, ParseShow b) => (Integer -> Integer -> Integer) -> a -> b -> m Experiment -combineRangesBinOp f a b = do - d <- range a - d' <- range b - return $ f <$> d <*> d' - rangeExpr :: (MonadException m) => Expr -> m Distribution rangeExpr e = do ex <- range e @@ -114,20 +106,30 @@ instance (RangeList a) => RangeList (Var a) where rangeList' (Var _ a) = rangeList a rangeList' (VarLazy _ a) = rangeList a +instance (ParseShow typ, Range sub) => Range (BinOp sub typ) where + range' (BinOp a tas) = foldl' foldel (range a) tas + where + foldel at (typ, b) = do + a' <- at + b' <- range b + return $ getOperation typ <$> a' <*> b' + instance Range Expr where - range' (NoExpr t) = range t - range' (Add t e) = combineRangesBinOp (+) t e - range' (Sub t e) = combineRangesBinOp (-) t e + range' (Expr e) = range e range' (ExprMisc t) = range t instance Range Term where - range' (NoTerm t) = range t - range' (Multi t e) = combineRangesBinOp (*) t e - range' (Div t e) = do - d <- range t - d' <- range e - -- If 0 is always the denominator, the distribution will be empty. - return $ div <$> d <*> from (assuming (/= 0) (run d')) + range' (Term (BinOp a tas)) = foldl' foldel (range a) tas + where + foldel at (Div, b) = do + a' <- at + b' <- range b + -- If 0 is always the denominator, the distribution will be empty. + return $ getOperation Div <$> a' <*> from (assuming (/= 0) (run b')) + foldel at (typ, b) = do + a' <- at + b' <- range b + return $ getOperation typ <$> a' <*> b' instance Range Negation where range' (Neg t) = fmap negate <$> range t diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 60c8efb..2b00529 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -203,7 +203,7 @@ genchar = Command "genchar" (snd $ head rpgSystems') (toCommand <$> rpgSystems') rpgSystems :: [(Text, ListValues)] rpgSystems = [ ("dnd", MultipleValues (Value 6) (DiceBase (Dice (NBase (Value 4)) (Die (Value 6)) (Just (DieOpRecur (DieOpOptionKD Drop (Low (Value 1))) Nothing))))), - ("wfrp", MultipleValues (Value 8) (NBase (NBParen (Paren (Add (promote (Value 20)) (promote (Die (Value 10)))))))) + ("wfrp", MultipleValues (Value 8) (NBase (NBParen (Paren (Expr (BinOp (promote (Value 20)) [(Add, promote (Die (Value 10)))])))))) ] -- | Small help page for gen char. From 4cbef87e33951541cdbf115921d12484655adf27 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Tue, 2 Aug 2022 20:18:48 +0100 Subject: [PATCH 02/53] changes to docs and minor formatting change --- src/Tablebot/Plugins/Roll/Dice.hs | 6 +++--- src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Dice.hs b/src/Tablebot/Plugins/Roll/Dice.hs index 365e44d..c70d1e7 100644 --- a/src/Tablebot/Plugins/Roll/Dice.hs +++ b/src/Tablebot/Plugins/Roll/Dice.hs @@ -40,10 +40,10 @@ -- vars - "var" spc1 "!"? ("l_" name spcs "=" spcs lstv | name spcs "=" spcs expr) -- lstv - nbse "#" base | funcBasics | lstb | name | misc -- lstb - "{" expr ("," expr)* "}" | "(" lstv ")" --- expr - term ([+-] expr)? | misc --- term - nega ([*/] term)? +-- expr - term ([+-] term)* | misc +-- term - nega ([*/] nega)* -- nega - "-" expo | expo --- expo - func "^" expo | func +-- expo - func ("^" func)* -- func - funcBasics | base -- base - dice | nbse | name -- nbse - "(" expr ")" | [0-9]+ diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs index 4e4d04b..704b068 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs @@ -285,7 +285,7 @@ instance ParseShow ArgValue where instance ParseShow ListValues where parseShow (LVBase e) = parseShow e parseShow (MultipleValues nb b) = parseShow nb <> "#" <> parseShow b - parseShow (LVFunc s n) = funcInfoName s <> "(" <> T.intercalate "," (parseShow <$> n) <> ")" + parseShow (LVFunc s n) = funcInfoName s <> "(" <> T.intercalate ", " (parseShow <$> n) <> ")" parseShow (LVVar t) = t parseShow (ListValuesMisc l) = parseShow l From aef69ec9b7568044516ecb8f69e06155aa15488d Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:09:38 +0000 Subject: [PATCH 03/53] add dockerfile --- Dockerfile | 32 ++++++++++++++++++++++++++++++++ 1 file changed, 32 insertions(+) create mode 100644 Dockerfile diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..d9c00f0 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,32 @@ +# stack resolver 18.18 uses ghc 8.10.7 +FROM haskell:8.10.7 as build +RUN mkdir -p /tablebot/build +WORKDIR /tablebot/build + +# system lib dependencies +RUN apt-get update -qq && \ + apt-get install -qq -y libpcre3-dev build-essential pkg-config libicu-dev --fix-missing --no-install-recommends && \ + apt-get clean && \ + rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* + +COPY . . + +RUN stack build --system-ghc + +RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin + +FROM haskell:8.10.7-slim as app + +# system runtime deps +RUN apt-get update -qq && \ + apt-get install -qq -y libpcre3 libicu63 --fix-missing --no-install-recommends && \ + apt-get clean && \ + rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* + +RUN mkdir -p /tablebot +WORKDIR /tablebot + +COPY --from=build /tablebot/build/bin . +# apparently we need the .git folder +COPY .git .git +CMD /tablebot/tablebot-exe From 2dbcf62bdabecb11f9d45bcc1db45a71e2424b47 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:19:13 +0000 Subject: [PATCH 04/53] make the build job within docker --- .github/workflows/main.yml | 50 +++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 19 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index f5723b2..2440ca3 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -6,7 +6,7 @@ name: CI on: # Triggers the workflow on push or pull request events but only for the main branch push: - branches: [ main ] + branches: [main] pull_request: # Allows you to run this workflow manually from the Actions tab @@ -17,26 +17,38 @@ jobs: ormolu: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - uses: mrkkrp/ormolu-action@v4 + build: - name: Build - runs-on: ubuntu-latest # or macOS-latest, or windows-latest - needs: ormolu + name: Build Docker Image + runs-on: ubuntu-latest + permissions: + packages: write + needs: + - ormolu + if: success() steps: - - uses: actions/checkout@v2 - - uses: haskell/actions/setup@v1 + - uses: actions/checkout@v3 + - name: Log in to the Container registry + uses: docker/login-action@v2 + if: github.ref_name == 'main' && github.event_name == 'push' # don't need to login if we're not pushing with: - ghc-version: 'latest' - enable-stack: true - stack-version: 'latest' - - name: Cache .stack - id: cache-stack - uses: actions/cache@v2 + registry: ghcr.io + username: ${{ github.repository_owner }} + password: ${{ secrets.GITHUB_TOKEN }} + + - name: Get short commit hash + id: hash + run: echo "sha_short=$(git rev-parse --short HEAD)" >> $GITHUB_OUTPUT + + - name: Build and push Docker image + uses: docker/build-push-action@v3 with: - path: ~/.stack - key: ${{ runner.os }}-stack-${{ hashFiles('stack.yaml') }} - restore-keys: | - ${{ runner.os }}-stack - ${{ runner.os }} - - run: stack build + context: . + push: github.ref_name == 'main' && github.event_name == 'push' # only actually publish on push to main + tags: | + "ghcr.io/${{ github.repository_owner }}/tablebot:latest" + "ghcr.io/${{ github.repository_owner }}/tablebot:${{ steps.hash.outputs.sha_short }}" + cache-from: type=gha + cache-to: type=gha,mode=max From 69f91031b7947f058bed2231a79b7b8a851ac4fc Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:22:07 +0000 Subject: [PATCH 05/53] something about the yaml spec --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 2440ca3..35c35cc 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -46,7 +46,7 @@ jobs: uses: docker/build-push-action@v3 with: context: . - push: github.ref_name == 'main' && github.event_name == 'push' # only actually publish on push to main + push: ${{ github.ref_name == 'main' && github.event_name == 'push' }} # only actually publish on push to main tags: | "ghcr.io/${{ github.repository_owner }}/tablebot:latest" "ghcr.io/${{ github.repository_owner }}/tablebot:${{ steps.hash.outputs.sha_short }}" From 40dfe4721f70a63fb9088ed4093551b1c476c4c9 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:24:02 +0000 Subject: [PATCH 06/53] add buildx to workflow --- .github/workflows/main.yml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 35c35cc..8f6f95a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -42,7 +42,10 @@ jobs: id: hash run: echo "sha_short=$(git rev-parse --short HEAD)" >> $GITHUB_OUTPUT - - name: Build and push Docker image + - name: Set up Docker Buildx + - uses: docker/setup-buildx-action@v2 + + - name: Build and Push Docker image uses: docker/build-push-action@v3 with: context: . From 3f3feafa0cef7c209c90465b7cfbfc93d3288933 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:24:24 +0000 Subject: [PATCH 07/53] i hate yaml --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 8f6f95a..a30975c 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -43,7 +43,7 @@ jobs: run: echo "sha_short=$(git rev-parse --short HEAD)" >> $GITHUB_OUTPUT - name: Set up Docker Buildx - - uses: docker/setup-buildx-action@v2 + uses: docker/setup-buildx-action@v2 - name: Build and Push Docker image uses: docker/build-push-action@v3 From b3519ae1f3a05fa6e3ecebd572be9c346146f5b0 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:32:05 +0000 Subject: [PATCH 08/53] try using the docker metadata thing --- .github/workflows/main.yml | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index a30975c..233259e 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -30,6 +30,7 @@ jobs: if: success() steps: - uses: actions/checkout@v3 + - name: Log in to the Container registry uses: docker/login-action@v2 if: github.ref_name == 'main' && github.event_name == 'push' # don't need to login if we're not pushing @@ -38,9 +39,12 @@ jobs: username: ${{ github.repository_owner }} password: ${{ secrets.GITHUB_TOKEN }} - - name: Get short commit hash - id: hash - run: echo "sha_short=$(git rev-parse --short HEAD)" >> $GITHUB_OUTPUT + - name: Get Docker Metadata + id: meta + uses: docker/metadata-action@v4 + with: + images: ghcr.io/${{ github.repository }} + tags: type=sha - name: Set up Docker Buildx uses: docker/setup-buildx-action@v2 @@ -49,7 +53,7 @@ jobs: uses: docker/build-push-action@v3 with: context: . - push: ${{ github.ref_name == 'main' && github.event_name == 'push' }} # only actually publish on push to main + push: ${{ github.event_name != 'pull_request' }} # dont push on a pull request tags: | "ghcr.io/${{ github.repository_owner }}/tablebot:latest" "ghcr.io/${{ github.repository_owner }}/tablebot:${{ steps.hash.outputs.sha_short }}" From e1b43781ec07bd96fe6229be55ad057410df162e Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:34:24 +0000 Subject: [PATCH 09/53] actually use the metadata generated --- .github/workflows/main.yml | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 233259e..a10e421 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -54,8 +54,7 @@ jobs: with: context: . push: ${{ github.event_name != 'pull_request' }} # dont push on a pull request - tags: | - "ghcr.io/${{ github.repository_owner }}/tablebot:latest" - "ghcr.io/${{ github.repository_owner }}/tablebot:${{ steps.hash.outputs.sha_short }}" + tags: ${{ steps.meta.outputs.tags }} + labels: ${{ steps.meta.outputs.labels }} cache-from: type=gha cache-to: type=gha,mode=max From fbe2e4a0e1d42a9481f5660af7ea8fdb76567b41 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 17:39:33 +0000 Subject: [PATCH 10/53] add latest tag to container build --- .github/workflows/main.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index a10e421..11ef08a 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -44,7 +44,9 @@ jobs: uses: docker/metadata-action@v4 with: images: ghcr.io/${{ github.repository }} - tags: type=sha + tags: | # tag with commit hash and with 'latest' + type=sha + type=raw,value=latest,enable={{is_default_branch}} - name: Set up Docker Buildx uses: docker/setup-buildx-action@v2 From bbc3fa56d3177bd76098ab0f26b81c84dab0f758 Mon Sep 17 00:00:00 2001 From: Joey Harrison Date: Sun, 15 Jan 2023 18:13:05 +0000 Subject: [PATCH 11/53] make the if conditions for push consistent --- .github/workflows/main.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 11ef08a..67ddbea 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -33,7 +33,7 @@ jobs: - name: Log in to the Container registry uses: docker/login-action@v2 - if: github.ref_name == 'main' && github.event_name == 'push' # don't need to login if we're not pushing + if: github.event_name != 'pull_request' # don't need to login if we're not pushing with: registry: ghcr.io username: ${{ github.repository_owner }} From 3a3a5f8d3323eac3ac02ffb6bc2c24f975c385d3 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Thu, 19 Jan 2023 16:37:59 +0000 Subject: [PATCH 12/53] switch to 'withSqlitePool' --- src/Tablebot.hs | 84 ++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/src/Tablebot.hs b/src/Tablebot.hs index 0aea8a8..d0f22d3 100644 --- a/src/Tablebot.hs +++ b/src/Tablebot.hs @@ -18,21 +18,20 @@ module Tablebot ) where -import Control.Concurrent import Control.Monad.Extra import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.Logger (NoLoggingT (runNoLoggingT)) +import Control.Monad.Logger (NoLoggingT (..)) import Control.Monad.Reader (runReaderT) import Control.Monad.Trans.Resource (runResourceT) import Data.Map as M (empty) import Data.Maybe (fromMaybe) import Data.Text (Text, pack) +import qualified Data.Text as T import Data.Text.Encoding (encodeUtf8) -import qualified Data.Text.IO as TIO (putStrLn) import Database.Persist.Sqlite - ( createSqlitePool, - runMigration, + ( runMigration, runSqlPool, + withSqlitePool, ) import Discord import Discord.Internal.Rest @@ -56,6 +55,7 @@ import Tablebot.Plugins (addAdministrationPlugin) import Tablebot.Utility import Tablebot.Utility.Help (generateHelp) import Text.Regex.PCRE ((=~)) +import UnliftIO.Concurrent -- | runTablebotWithEnv @plugins@ runs the bot using data found in the .env -- file with the @[CompiledPlugin]@ given. If you're looking to run the bot as @@ -101,46 +101,46 @@ runTablebot vinfo dToken prefix dbpath plugins config = do debugPrint ("DEBUG enabled. This is strongly not recommended in production!" :: String) -- Create multiple database threads. - pool <- runNoLoggingT $ createSqlitePool (pack dbpath) 8 + runNoLoggingT . withSqlitePool (pack dbpath) 8 $ \pool -> do + -- Setup and then apply plugin blacklist from the database + runSqlPool (runMigration adminMigration) pool + blacklist <- runResourceT $ runNoLoggingT $ runSqlPool currentBlacklist pool + let filteredPlugins = removeBlacklisted blacklist plugins + -- Combine the list of plugins into both a combined plugin + let !plugin = generateHelp (rootHelpText config) $ combinePlugins filteredPlugins + -- Run the setup actions of each plugin and collect the plugin actions into a single @PluginActions@ instance + allActions <- NoLoggingT $ mapM (runResourceT . runNoLoggingT . flip runSqlPool pool) (combinedSetupAction plugin) + let !actions = combineActions allActions - -- Setup and then apply plugin blacklist from the database - runSqlPool (runMigration adminMigration) pool - blacklist <- runResourceT $ runNoLoggingT $ runSqlPool currentBlacklist pool - let filteredPlugins = removeBlacklisted blacklist plugins - -- Combine the list of plugins into both a combined plugin - let !plugin = generateHelp (rootHelpText config) $ combinePlugins filteredPlugins - -- Run the setup actions of each plugin and collect the plugin actions into a single @PluginActions@ instance - allActions <- mapM (runResourceT . runNoLoggingT . flip runSqlPool pool) (combinedSetupAction plugin) - let !actions = combineActions allActions + -- TODO: this might have issues with duplicates? + -- TODO: in production, this should probably run once and then never again. + mapM_ (\migration -> runSqlPool (runMigration migration) pool) $ combinedMigrations plugin + -- Create a var to kill any ongoing tasks. + mvar <- newEmptyMVar + cacheMVar <- newMVar (TCache M.empty M.empty vinfo) + userFacingError <- + NoLoggingT $ + runDiscord $ + def + { discordToken = dToken, + discordOnEvent = + flip runSqlPool pool . flip runReaderT cacheMVar . eventHandler actions prefix, + discordOnStart = do + -- Build list of cron jobs, saving them to the mvar. + -- Note that we cannot just use @runSqlPool@ here - this creates + -- a single transaction which is reverted in case of exception + -- (which can just happen due to databases being unavailable + -- sometimes). + runReaderT (mapM (runCron pool) (compiledCronJobs actions) >>= liftIO . putMVar mvar) cacheMVar - -- TODO: this might have issues with duplicates? - -- TODO: in production, this should probably run once and then never again. - mapM_ (\migration -> runSqlPool (runMigration migration) pool) $ combinedMigrations plugin - -- Create a var to kill any ongoing tasks. - mvar <- newEmptyMVar :: IO (MVar [ThreadId]) - cacheMVar <- newMVar (TCache M.empty M.empty vinfo) :: IO (MVar TablebotCache) - userFacingError <- - runDiscord $ - def - { discordToken = dToken, - discordOnEvent = - flip runSqlPool pool . flip runReaderT cacheMVar . eventHandler actions prefix, - discordOnStart = do - -- Build list of cron jobs, saving them to the mvar. - -- Note that we cannot just use @runSqlPool@ here - this creates - -- a single transaction which is reverted in case of exception - -- (which can just happen due to databases being unavailable - -- sometimes). - runReaderT (mapM (runCron pool) (compiledCronJobs actions) >>= liftIO . putMVar mvar) cacheMVar + submitApplicationCommands (compiledApplicationCommands actions) cacheMVar - submitApplicationCommands (compiledApplicationCommands actions) cacheMVar - - liftIO $ putStrLn "The bot lives!" - sendCommand (UpdateStatus activityStatus), - -- Kill every cron job in the mvar. - discordOnEnd = takeMVar mvar >>= killCron - } - TIO.putStrLn userFacingError + liftIO $ putStrLn "The bot lives!" + sendCommand (UpdateStatus activityStatus), + -- Kill every cron job in the mvar. + discordOnEnd = takeMVar mvar >>= killCron + } + liftIO $ putStrLn $ T.unpack userFacingError where activityStatus = UpdateStatusOpts From fb98a2a89778d1d2dbb7be940ea24a39581d4114 Mon Sep 17 00:00:00 2001 From: Finnbar Keating Date: Sat, 4 Feb 2023 13:32:23 +0000 Subject: [PATCH 13/53] Update rts opts --- package.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/package.yaml b/package.yaml index c641120..fd29c68 100644 --- a/package.yaml +++ b/package.yaml @@ -109,7 +109,7 @@ executables: ghc-options: - -threaded - -rtsopts - - -with-rtsopts=-N + - "\"-with-rtsopts=-Iw10 -N\"" dependencies: - tablebot From c0ee0bad2c4b52c460221a3bb368ca6eb9f90b4d Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sun, 19 Feb 2023 20:27:04 +0000 Subject: [PATCH 14/53] add fonts --- fonts/LinLibertine_R.svg | 10319 ++++++++++++++++++++++++++++++++++ fonts/LinLibertine_RB.svg | 9167 ++++++++++++++++++++++++++++++ fonts/LinLibertine_RBI.svg | 6768 ++++++++++++++++++++++ fonts/LinLibertine_RI.svg | 9071 ++++++++++++++++++++++++++++++ fonts/SourceCodePro_R.svg | 2421 ++++++++ fonts/SourceCodePro_RB.svg | 2401 ++++++++ fonts/SourceSansPro_R.svg | 6374 +++++++++++++++++++++ fonts/SourceSansPro_RB.svg | 6048 ++++++++++++++++++++ fonts/SourceSansPro_RBI.svg | 4316 ++++++++++++++ fonts/SourceSansPro_RI.svg | 4357 ++++++++++++++ 10 files changed, 61242 insertions(+) create mode 100644 fonts/LinLibertine_R.svg create mode 100644 fonts/LinLibertine_RB.svg create mode 100644 fonts/LinLibertine_RBI.svg create mode 100644 fonts/LinLibertine_RI.svg create mode 100644 fonts/SourceCodePro_R.svg create mode 100644 fonts/SourceCodePro_RB.svg create mode 100644 fonts/SourceSansPro_R.svg create mode 100644 fonts/SourceSansPro_RB.svg create mode 100644 fonts/SourceSansPro_RBI.svg create mode 100644 fonts/SourceSansPro_RI.svg diff --git a/fonts/LinLibertine_R.svg b/fonts/LinLibertine_R.svg new file mode 100644 index 0000000..3f16783 --- /dev/null +++ b/fonts/LinLibertine_R.svg @@ -0,0 +1,10319 @@ + + + + + +Created by FontForge 20120601 at Mon Jul 2 00:09:39 2012 + By Gillian Tiefenlicht +Linux Libertine by Philipp H. Poll, +Open Font under Terms of following Free Software Licenses: +GPL (General Public License) with font-exception and OFL (Open Font License). +Created with FontForge (http://fontforge.sf.net) +Sept 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,2012 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/LinLibertine_RB.svg b/fonts/LinLibertine_RB.svg new file mode 100644 index 0000000..215c305 --- /dev/null +++ b/fonts/LinLibertine_RB.svg @@ -0,0 +1,9167 @@ + + + + + +Created by FontForge 20120601 at Mon Jul 2 00:09:41 2012 + By Gillian Tiefenlicht +Linux Libertine by Philipp H. Poll, +Open Font under Terms of following Free Software Licenses: +GPL (General Public License) with font-exception and OFL (Open Font License). +Created with FontForge (http://fontforge.sf.net) +Sept 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,2012 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/LinLibertine_RBI.svg b/fonts/LinLibertine_RBI.svg new file mode 100644 index 0000000..9300b15 --- /dev/null +++ b/fonts/LinLibertine_RBI.svg @@ -0,0 +1,6768 @@ + + + + + +Created by FontForge 20120601 at Mon Jul 2 00:09:41 2012 + By Gillian Tiefenlicht +Linux Libertine by Philipp H. Poll, +Open Font under Terms of following Free Software Licenses: +GPL (General Public License) with font-exception and OFL (Open Font License). +Created with FontForge (http://fontforge.sf.net) +Sept 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,2012 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/LinLibertine_RI.svg b/fonts/LinLibertine_RI.svg new file mode 100644 index 0000000..63f18e9 --- /dev/null +++ b/fonts/LinLibertine_RI.svg @@ -0,0 +1,9071 @@ + + + + + +Created by FontForge 20120601 at Mon Jul 2 00:09:38 2012 + By Gillian Tiefenlicht +Linux Libertine by Philipp H. Poll, +Open Font under Terms of following Free Software Licenses: +GPL (General Public License) with font-exception and OFL (Open Font License). +Created with FontForge (http://fontforge.sf.net) +Sept 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011,2012 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceCodePro_R.svg b/fonts/SourceCodePro_R.svg new file mode 100644 index 0000000..12849b9 --- /dev/null +++ b/fonts/SourceCodePro_R.svg @@ -0,0 +1,2421 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:17:38 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceCodePro_RB.svg b/fonts/SourceCodePro_RB.svg new file mode 100644 index 0000000..b227e44 --- /dev/null +++ b/fonts/SourceCodePro_RB.svg @@ -0,0 +1,2401 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:16:54 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceSansPro_R.svg b/fonts/SourceSansPro_R.svg new file mode 100644 index 0000000..22d4448 --- /dev/null +++ b/fonts/SourceSansPro_R.svg @@ -0,0 +1,6374 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:19:42 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceSansPro_RB.svg b/fonts/SourceSansPro_RB.svg new file mode 100644 index 0000000..856f8ec --- /dev/null +++ b/fonts/SourceSansPro_RB.svg @@ -0,0 +1,6048 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:18:11 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceSansPro_RBI.svg b/fonts/SourceSansPro_RBI.svg new file mode 100644 index 0000000..85ff48f --- /dev/null +++ b/fonts/SourceSansPro_RBI.svg @@ -0,0 +1,4316 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:18:52 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/fonts/SourceSansPro_RI.svg b/fonts/SourceSansPro_RI.svg new file mode 100644 index 0000000..81112d8 --- /dev/null +++ b/fonts/SourceSansPro_RI.svg @@ -0,0 +1,4357 @@ + + + + +Created by FontForge 20110222 at Mon Jul 29 16:19:17 2013 + By Jan Bracker,,, +Copyright 2010, 2012 Adobe Systems Incorporated. All Rights Reserved. + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + From 738c7155980ced61620b94566e25d022462035df Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sun, 19 Feb 2023 20:32:00 +0000 Subject: [PATCH 15/53] custom font loading for dice stats --- .env.example | 1 + README.md | 1 + package.yaml | 2 + .../Plugins/Roll/Dice/DiceStatsBase.hs | 5 +- src/Tablebot/Utility/Font.hs | 64 +++++++++++++++++++ 5 files changed, 71 insertions(+), 2 deletions(-) create mode 100644 src/Tablebot/Utility/Font.hs diff --git a/.env.example b/.env.example index 2d641d2..3b44c9c 100644 --- a/.env.example +++ b/.env.example @@ -9,4 +9,5 @@ SUPERUSER_GROUP=147258369147258369 SERVER_ID=314159265358979323 ALLOW_GIT_UPDATE=False EMOJI_SERVERS=[121213131414151516] +FONT_PATH=/path/to/running/folder/ # NOTE: YOU MUST HAVE A NEWLINE AT THE END OF THE FILE diff --git a/README.md b/README.md index e8ee3b9..e0bd4fd 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,7 @@ Create a `.env` file containing the following keys. Consult `.env.example` if yo * `SERVER_ID` (optional) - either `global` or the id of the server the bot will mainly be deployed in. Application commands will be registered here. If absent, application commands won't be registered. * `EMOJI_SERVERS` (optional) - a list of server IDs that the bot will search for emoji within. +* `FONT_PATH` (semi-optional) - the full path to the fonts used by rolling stats. Not required if you disable that module. * `ALLOW_GIT_UPDATE` (optional) - a `true` or `false` value that determines whether the bot can automatically load data from the repository. **Warning!** Be very careful with setting this to true; if you haven't set up permissions properly on your repo and your discord servers then things can go wrong! diff --git a/package.yaml b/package.yaml index fd29c68..0896e71 100644 --- a/package.yaml +++ b/package.yaml @@ -69,6 +69,8 @@ dependencies: - distribution - extra - process +- filepath +- SVGFonts library: source-dirs: src diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs index 266458e..553f440 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs @@ -25,10 +25,11 @@ import qualified Data.Text as T import Diagrams (Diagram, dims2D, renderDia) import Diagrams.Backend.Rasterific import Graphics.Rendering.Chart.Axis.Int -import Graphics.Rendering.Chart.Backend.Diagrams (defaultEnv, runBackendR) +import Graphics.Rendering.Chart.Backend.Diagrams (runBackendR) import Graphics.Rendering.Chart.Backend.Types import Graphics.Rendering.Chart.Easy import Tablebot.Plugins.Roll.Dice.DiceEval (evaluationException) +import Tablebot.Utility.Font (makeSansSerifvEnv) -- | A wrapper type for mapping values to their probabilities. type Distribution = D.Distribution Integer @@ -51,7 +52,7 @@ distributionDiagram d = do if null d then evaluationException "empty distribution" [] else do - defEnv <- defaultEnv (AlignmentFns id id) diagramX diagramY + defEnv <- makeSansSerifvEnv diagramX diagramY return . fst $ runBackendR defEnv r where r = distributionRenderable d diff --git a/src/Tablebot/Utility/Font.hs b/src/Tablebot/Utility/Font.hs new file mode 100644 index 0000000..e2f041e --- /dev/null +++ b/src/Tablebot/Utility/Font.hs @@ -0,0 +1,64 @@ +module Tablebot.Utility.Font (makeSansSerifvEnv) where + +import qualified Data.Map as M +import Graphics.Rendering.Chart.Backend.Diagrams (DEnv (..), createEnv) +import Graphics.Rendering.Chart.Backend.Types +import Graphics.SVGFonts (loadFont) +import qualified Graphics.SVGFonts.ReadFont as F +import System.Environment (lookupEnv) +import System.FilePath (replaceFileName) +import Tablebot.Plugins.Roll.Dice.DiceEval (evaluationException) + +makeSansSerifvEnv :: (Read n, RealFloat n) => n -> n -> IO (DEnv n) +makeSansSerifvEnv diX diY = do + exec <- lookupEnv "FONT_PATH" + case exec of + Nothing -> evaluationException "cannot find FONT_PATH env variable" [] + Just exec' -> do + -- we only care about sans-serif, since that's the default. + -- this is done here to prevent having to load all the fonts + let local = M.filterWithKey (\(nm, _, _) _ -> nm == "sans-serif") $ localFonts exec' + localLookedUp <- mapM loadFont local + let localAltered = M.mapWithKey (\(s, _, _) v -> alterFontFamily s v) localLookedUp + -- we simplify the map so that other font types become sans-serif as well + localKeySimple = M.mapKeys (\(_, fs, fw) -> (fs, fw)) localAltered + -- we use an unsafe lookup method because what do we do if this isn't correct? + fontSelector FontStyle {..} = localKeySimple M.! (_font_slant, _font_weight) + pure $ createEnv (AlignmentFns id id) diX diY fontSelector + where + alterFontFamily :: String -> F.PreparedFont n -> F.PreparedFont n + alterFontFamily n (fd, om) = (fd {F.fontDataFamily = n}, om) + +-- thanks to https://stackoverflow.com/questions/21549082/how-do-i-deploy-an-executable-using-chart-diagrams-standard-fonts-without-cabal +localFonts :: FilePath -> M.Map (String, FontSlant, FontWeight) FilePath +localFonts exec = + let serifR = replaceFileName exec "fonts/LinLibertine_R.svg" + serifRB = replaceFileName exec "fonts/LinLibertine_RB.svg" + serifRBI = replaceFileName exec "fonts/LinLibertine_RBI.svg" + serifRI = replaceFileName exec "fonts/LinLibertine_RI.svg" + sansR = replaceFileName exec "fonts/SourceSansPro_R.svg" + sansRB = replaceFileName exec "fonts/SourceSansPro_RB.svg" + sansRBI = replaceFileName exec "fonts/SourceSansPro_RBI.svg" + sansRI = replaceFileName exec "fonts/SourceSansPro_RI.svg" + monoR = replaceFileName exec "fonts/SourceCodePro_R.svg" + monoRB = replaceFileName exec "fonts/SourceCodePro_RB.svg" + in M.fromList + [ (("serif", FontSlantNormal, FontWeightNormal), serifR), + (("serif", FontSlantNormal, FontWeightBold), serifRB), + (("serif", FontSlantItalic, FontWeightNormal), serifRI), + (("serif", FontSlantOblique, FontWeightNormal), serifRI), + (("serif", FontSlantItalic, FontWeightBold), serifRBI), + (("serif", FontSlantOblique, FontWeightBold), serifRBI), + (("sans-serif", FontSlantNormal, FontWeightNormal), sansR), + (("sans-serif", FontSlantNormal, FontWeightBold), sansRB), + (("sans-serif", FontSlantItalic, FontWeightNormal), sansRI), + (("sans-serif", FontSlantOblique, FontWeightNormal), sansRI), + (("sans-serif", FontSlantItalic, FontWeightBold), sansRBI), + (("sans-serif", FontSlantOblique, FontWeightBold), sansRBI), + (("monospace", FontSlantNormal, FontWeightNormal), monoR), + (("monospace", FontSlantNormal, FontWeightBold), monoRB), + (("monospace", FontSlantItalic, FontWeightNormal), monoR), + (("monospace", FontSlantOblique, FontWeightNormal), monoR), + (("monospace", FontSlantItalic, FontWeightBold), monoRB), + (("monospace", FontSlantOblique, FontWeightBold), monoRB) + ] From d24ed28dc35fc879f1c5030c051272752c238713 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sun, 19 Feb 2023 20:32:28 +0000 Subject: [PATCH 16/53] update dockerfile to copy across fonts --- Dockerfile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Dockerfile b/Dockerfile index d9c00f0..b4479d2 100644 --- a/Dockerfile +++ b/Dockerfile @@ -29,4 +29,6 @@ WORKDIR /tablebot COPY --from=build /tablebot/build/bin . # apparently we need the .git folder COPY .git .git +# we need fonts for the roll stats +COPY fonts fonts CMD /tablebot/tablebot-exe From 019fdc735a4783fefd1ade7eccca2f8e8bcc4eae Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sun, 19 Feb 2023 20:33:21 +0000 Subject: [PATCH 17/53] slight refactor of dice stats --- src/Tablebot/Plugins/Roll/Plugin.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 60c8efb..4fee309 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -223,6 +223,8 @@ statsCommand :: Command statsCommand = Command "stats" statsCommandParser [] where oneSecond = 1000000 + fiveSeconds = 5 * oneSecond + timeoutTime = fiveSeconds statsCommandParser :: Parser (Message -> DatabaseDiscord ()) statsCommandParser = do firstE <- pars @@ -230,11 +232,11 @@ statsCommand = Command "stats" statsCommandParser [] return $ statsCommand' (firstE : restEs) statsCommand' :: [Expr] -> Message -> DatabaseDiscord () statsCommand' es m = do - mrange' <- liftIO $ timeout (oneSecond * 5) $ mapM (\e -> rangeExpr e >>= \re -> re `seq` return (re, parseShow e)) es + mrange' <- liftIO $ timeout timeoutTime $ mapM (\e -> rangeExpr e >>= \re -> re `seq` return (re, parseShow e)) es case mrange' of Nothing -> throwBot (EvaluationException "Timed out calculating statistics" []) (Just range') -> do - mimage <- liftIO $ timeout (oneSecond * 5) (distributionByteString range' >>= \res -> res `seq` return res) + mimage <- liftIO $ timeout timeoutTime (distributionByteString range' >>= \res -> res `seq` return res) case mimage of Nothing -> do sendMessage m (msg range') From 4f4327545aaba22c5907c1071365d51f155bc7d0 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Sun, 19 Feb 2023 21:27:37 +0000 Subject: [PATCH 18/53] added font generation to startup, and use those fonts instead of reading them from file when asked for --- src/Tablebot.hs | 4 +- src/Tablebot/Internal/Cache.hs | 7 +++ src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 6 +-- .../Plugins/Roll/Dice/DiceStatsBase.hs | 16 +++---- src/Tablebot/Plugins/Roll/Plugin.hs | 4 +- src/Tablebot/Utility/Exception.hs | 6 +++ src/Tablebot/Utility/Font.hs | 44 +++++++++++-------- src/Tablebot/Utility/Types.hs | 8 ++-- 8 files changed, 59 insertions(+), 36 deletions(-) diff --git a/src/Tablebot.hs b/src/Tablebot.hs index d0f22d3..10d4b5d 100644 --- a/src/Tablebot.hs +++ b/src/Tablebot.hs @@ -53,6 +53,7 @@ import Tablebot.Internal.Plugins import Tablebot.Internal.Types import Tablebot.Plugins (addAdministrationPlugin) import Tablebot.Utility +import Tablebot.Utility.Font (makeFontMap) import Tablebot.Utility.Help (generateHelp) import Text.Regex.PCRE ((=~)) import UnliftIO.Concurrent @@ -117,7 +118,8 @@ runTablebot vinfo dToken prefix dbpath plugins config = mapM_ (\migration -> runSqlPool (runMigration migration) pool) $ combinedMigrations plugin -- Create a var to kill any ongoing tasks. mvar <- newEmptyMVar - cacheMVar <- newMVar (TCache M.empty M.empty vinfo) + fm <- NoLoggingT makeFontMap + cacheMVar <- newMVar (TCache M.empty M.empty vinfo fm) userFacingError <- NoLoggingT $ runDiscord $ diff --git a/src/Tablebot/Internal/Cache.hs b/src/Tablebot/Internal/Cache.hs index 707a6e3..1087b0b 100644 --- a/src/Tablebot/Internal/Cache.hs +++ b/src/Tablebot/Internal/Cache.hs @@ -16,6 +16,7 @@ import Control.Monad.Trans.Reader (ask) import qualified Data.Map as M import Data.Text (Text) import Discord.Types +import Tablebot.Utility.Font (FontMap) import Tablebot.Utility.Types lookupEmojiCache :: Text -> EnvDatabaseDiscord s (Maybe Emoji) @@ -49,3 +50,9 @@ getVersionInfo = do mcache <- liftCache ask cache <- liftIO $ readMVar mcache pure $ cacheVersionInfo cache + +getFontMap :: EnvDatabaseDiscord s (FontMap Double) +getFontMap = do + mcache <- liftCache ask + cache <- liftIO $ readMVar mcache + pure $ cacheFonts cache diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index f276910..c4ec7aa 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -23,7 +23,7 @@ import Tablebot.Plugins.Roll.Dice.DiceData import Tablebot.Plugins.Roll.Dice.DiceFunctions (FuncInfoBase (..), ListInteger (..)) import Tablebot.Plugins.Roll.Dice.DiceParsing () import Tablebot.Utility.Discord (Format (..), formatInput, formatText) -import Tablebot.Utility.Exception (BotException (EvaluationException), catchBot, throwBot) +import Tablebot.Utility.Exception (BotException (EvaluationException), catchBot, evaluationException, throwBot) import Tablebot.Utility.Parser (ParseShow (parseShow)) import Tablebot.Utility.Random (chooseOne) @@ -65,10 +65,6 @@ checkRNGCount = do rngCount <- gets getRNGCount when (rngCount > maximumRNG) $ evaluationException ("Maximum RNG count exceeded (" <> pack (show maximumRNG) <> ")") [] --- | Utility function to throw an `EvaluationException` when using `Text`. -evaluationException :: (MonadException m) => Text -> [Text] -> m a -evaluationException nm locs = throwBot $ EvaluationException (unpack nm) (unpack <$> locs) - --- Evaluating an expression. Uses IO because dice are random -- | Evaluating a full program diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs index 553f440..fbb7ff2 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs @@ -15,6 +15,7 @@ module Tablebot.Plugins.Roll.Dice.DiceStatsBase where import Codec.Picture (PngSavable (encodePng)) +import Control.Monad.Exception (MonadException) import Data.Bifunctor import qualified Data.ByteString.Lazy as B import qualified Data.Distribution as D @@ -29,7 +30,7 @@ import Graphics.Rendering.Chart.Backend.Diagrams (runBackendR) import Graphics.Rendering.Chart.Backend.Types import Graphics.Rendering.Chart.Easy import Tablebot.Plugins.Roll.Dice.DiceEval (evaluationException) -import Tablebot.Utility.Font (makeSansSerifvEnv) +import Tablebot.Utility.Font (FontMap, makeSansSerifEnv) -- | A wrapper type for mapping values to their probabilities. type Distribution = D.Distribution Integer @@ -40,22 +41,21 @@ diagramX, diagramY :: Double -- | Get the ByteString representation of the given distribution, setting the -- string as its title. -distributionByteString :: [(Distribution, T.Text)] -> IO B.ByteString -distributionByteString d = encodePng . renderDia Rasterific opts <$> distributionDiagram d +distributionByteString :: MonadException m => FontMap Double -> [(Distribution, T.Text)] -> m B.ByteString +distributionByteString fontMap d = encodePng . renderDia Rasterific opts <$> distributionDiagram fontMap d where opts = RasterificOptions (dims2D diagramX diagramY) -- | Get the Diagram representation of the given distribution, setting the -- string as its title. -distributionDiagram :: [(Distribution, T.Text)] -> IO (Diagram B) -distributionDiagram d = do +distributionDiagram :: MonadException m => FontMap Double -> [(Distribution, T.Text)] -> m (Diagram B) +distributionDiagram fontMap d = do if null d then evaluationException "empty distribution" [] - else do - defEnv <- makeSansSerifvEnv diagramX diagramY - return . fst $ runBackendR defEnv r + else return . fst $ runBackendR defEnv r where r = distributionRenderable d + defEnv = makeSansSerifEnv diagramX diagramY fontMap -- | Get the Renderable representation of the given distribution, setting the -- string as its title. diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 4fee309..be366dd 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -23,6 +23,7 @@ import Discord.Interactions import Discord.Internal.Rest.Channel (ChannelRequest (..), MessageDetailedOpts (..)) import Discord.Types (ActionRow (..), Button (..), Message (..), User (..), UserId, mkButton, mkEmoji) import System.Timeout (timeout) +import Tablebot.Internal.Cache (getFontMap) import Tablebot.Internal.Handler.Command (parseValue) import Tablebot.Plugins.Roll.Dice import Tablebot.Plugins.Roll.Dice.DiceData @@ -236,7 +237,8 @@ statsCommand = Command "stats" statsCommandParser [] case mrange' of Nothing -> throwBot (EvaluationException "Timed out calculating statistics" []) (Just range') -> do - mimage <- liftIO $ timeout timeoutTime (distributionByteString range' >>= \res -> res `seq` return res) + fontMap <- getFontMap + mimage <- liftIO $ timeout timeoutTime (distributionByteString fontMap range' >>= \res -> res `seq` return res) case mimage of Nothing -> do sendMessage m (msg range') diff --git a/src/Tablebot/Utility/Exception.hs b/src/Tablebot/Utility/Exception.hs index 3e8231b..46396fc 100644 --- a/src/Tablebot/Utility/Exception.hs +++ b/src/Tablebot/Utility/Exception.hs @@ -16,12 +16,14 @@ module Tablebot.Utility.Exception showError, showUserError, embedError, + evaluationException, ) where import Control.Monad.Exception (Exception, MonadException, catch, throw) import Data.List (intercalate) import Data.Text (pack) +import qualified Data.Text as T import Discord.Internal.Types import Tablebot.Utility.Embed @@ -73,6 +75,10 @@ formatUserError name' message = ++ message ++ "`" +-- | Utility function to throw an `EvaluationException` when using `Text`. +evaluationException :: (MonadException m) => T.Text -> [T.Text] -> m a +evaluationException nm locs = throwBot $ EvaluationException (T.unpack nm) (T.unpack <$> locs) + -- | @ErrorInfo@ packs the info for each error into one data type. This allows -- each error type to be defined in one block (as opposed to errorName being -- defined for each error type _then_ errorMsg being defined for each type). diff --git a/src/Tablebot/Utility/Font.hs b/src/Tablebot/Utility/Font.hs index e2f041e..7e558ce 100644 --- a/src/Tablebot/Utility/Font.hs +++ b/src/Tablebot/Utility/Font.hs @@ -1,5 +1,9 @@ -module Tablebot.Utility.Font (makeSansSerifvEnv) where +{-# LANGUAGE ScopedTypeVariables #-} +module Tablebot.Utility.Font (makeSansSerifEnv, FontMap, makeFontMap) where + +import Control.Monad.Exception (MonadException) +import Control.Monad.IO.Class (MonadIO (..)) import qualified Data.Map as M import Graphics.Rendering.Chart.Backend.Diagrams (DEnv (..), createEnv) import Graphics.Rendering.Chart.Backend.Types @@ -7,27 +11,31 @@ import Graphics.SVGFonts (loadFont) import qualified Graphics.SVGFonts.ReadFont as F import System.Environment (lookupEnv) import System.FilePath (replaceFileName) -import Tablebot.Plugins.Roll.Dice.DiceEval (evaluationException) -makeSansSerifvEnv :: (Read n, RealFloat n) => n -> n -> IO (DEnv n) -makeSansSerifvEnv diX diY = do - exec <- lookupEnv "FONT_PATH" - case exec of - Nothing -> evaluationException "cannot find FONT_PATH env variable" [] - Just exec' -> do - -- we only care about sans-serif, since that's the default. - -- this is done here to prevent having to load all the fonts - let local = M.filterWithKey (\(nm, _, _) _ -> nm == "sans-serif") $ localFonts exec' - localLookedUp <- mapM loadFont local - let localAltered = M.mapWithKey (\(s, _, _) v -> alterFontFamily s v) localLookedUp - -- we simplify the map so that other font types become sans-serif as well - localKeySimple = M.mapKeys (\(_, fs, fw) -> (fs, fw)) localAltered - -- we use an unsafe lookup method because what do we do if this isn't correct? - fontSelector FontStyle {..} = localKeySimple M.! (_font_slant, _font_weight) - pure $ createEnv (AlignmentFns id id) diX diY fontSelector +-- | A type to map between some basic font characteristics and some loaded fonts. +type FontMap n = M.Map (String, FontSlant, FontWeight) (F.PreparedFont n) + +makeSansSerifEnv :: forall n. (Read n, RealFloat n) => n -> n -> FontMap n -> DEnv n +makeSansSerifEnv diX diY fontMap = createEnv (AlignmentFns id id) diX diY fontSelector where alterFontFamily :: String -> F.PreparedFont n -> F.PreparedFont n alterFontFamily n (fd, om) = (fd {F.fontDataFamily = n}, om) + localSansSerif :: FontMap n = M.filterWithKey (\(k, _, _) _ -> k == "sans-serif") fontMap + localAltered :: FontMap n = M.mapWithKey (\(s, _, _) v -> alterFontFamily s v) localSansSerif + -- we simplify the map so that other font types become sans-serif as well + localKeySimple = M.mapKeys (\(_, fs, fw) -> (fs, fw)) localAltered + -- we use an unsafe lookup method because what do we do if this isn't correct? + fontSelector :: FontStyle -> F.PreparedFont n + fontSelector FontStyle {..} = localKeySimple M.! (_font_slant, _font_weight) + +makeFontMap :: (Read n, RealFloat n, MonadIO m, MonadException m) => m (FontMap n) +makeFontMap = do + exec <- liftIO $ lookupEnv "FONT_PATH" + case exec of + Nothing -> liftIO $ putStrLn "could not find env var FONT_PATH" >> pure M.empty + Just exec' -> do + let local = localFonts exec' + mapM (liftIO . loadFont) local -- thanks to https://stackoverflow.com/questions/21549082/how-do-i-deploy-an-executable-using-chart-diagrams-standard-fonts-without-cabal localFonts :: FilePath -> M.Map (String, FontSlant, FontWeight) FilePath diff --git a/src/Tablebot/Utility/Types.hs b/src/Tablebot/Utility/Types.hs index 34002f2..097dfe8 100644 --- a/src/Tablebot/Utility/Types.hs +++ b/src/Tablebot/Utility/Types.hs @@ -28,6 +28,7 @@ import Discord.Interactions import Discord.Internal.Rest.Channel (MessageDetailedOpts (MessageDetailedOpts)) import qualified Discord.Requests as R import Discord.Types +import Tablebot.Utility.Font (FontMap) import Text.Megaparsec (Parsec) -- * DatabaseDiscord @@ -48,9 +49,10 @@ type DatabaseDiscord = EnvDatabaseDiscord () type Database d = SqlPersistM d data TablebotCache = TCache - { cacheKnownEmoji :: Map Text Emoji, - cacheApplicationCommands :: Map ApplicationCommandId (Interaction -> EnvDatabaseDiscord () ()), - cacheVersionInfo :: VersionInfo + { cacheKnownEmoji :: !(Map Text Emoji), + cacheApplicationCommands :: !(Map ApplicationCommandId (Interaction -> EnvDatabaseDiscord () ())), + cacheVersionInfo :: !VersionInfo, + cacheFonts :: !(FontMap Double) } data VersionInfo = VInfo From b0d392638c08ea98b050e886c88c8697f082f331 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 19:55:28 +0100 Subject: [PATCH 19/53] Removing FONT_PATH env variable, using relative paths instead --- .env.example | 1 - README.md | 1 - src/Tablebot/Utility/Font.hs | 59 +++++++++++++----------------------- 3 files changed, 21 insertions(+), 40 deletions(-) diff --git a/.env.example b/.env.example index 3b44c9c..2d641d2 100644 --- a/.env.example +++ b/.env.example @@ -9,5 +9,4 @@ SUPERUSER_GROUP=147258369147258369 SERVER_ID=314159265358979323 ALLOW_GIT_UPDATE=False EMOJI_SERVERS=[121213131414151516] -FONT_PATH=/path/to/running/folder/ # NOTE: YOU MUST HAVE A NEWLINE AT THE END OF THE FILE diff --git a/README.md b/README.md index e0bd4fd..e8ee3b9 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,6 @@ Create a `.env` file containing the following keys. Consult `.env.example` if yo * `SERVER_ID` (optional) - either `global` or the id of the server the bot will mainly be deployed in. Application commands will be registered here. If absent, application commands won't be registered. * `EMOJI_SERVERS` (optional) - a list of server IDs that the bot will search for emoji within. -* `FONT_PATH` (semi-optional) - the full path to the fonts used by rolling stats. Not required if you disable that module. * `ALLOW_GIT_UPDATE` (optional) - a `true` or `false` value that determines whether the bot can automatically load data from the repository. **Warning!** Be very careful with setting this to true; if you haven't set up permissions properly on your repo and your discord servers then things can go wrong! diff --git a/src/Tablebot/Utility/Font.hs b/src/Tablebot/Utility/Font.hs index 7e558ce..ed0aa13 100644 --- a/src/Tablebot/Utility/Font.hs +++ b/src/Tablebot/Utility/Font.hs @@ -29,44 +29,27 @@ makeSansSerifEnv diX diY fontMap = createEnv (AlignmentFns id id) diX diY fontSe fontSelector FontStyle {..} = localKeySimple M.! (_font_slant, _font_weight) makeFontMap :: (Read n, RealFloat n, MonadIO m, MonadException m) => m (FontMap n) -makeFontMap = do - exec <- liftIO $ lookupEnv "FONT_PATH" - case exec of - Nothing -> liftIO $ putStrLn "could not find env var FONT_PATH" >> pure M.empty - Just exec' -> do - let local = localFonts exec' - mapM (liftIO . loadFont) local +makeFontMap = mapM (liftIO . loadFont) localFonts -- thanks to https://stackoverflow.com/questions/21549082/how-do-i-deploy-an-executable-using-chart-diagrams-standard-fonts-without-cabal -localFonts :: FilePath -> M.Map (String, FontSlant, FontWeight) FilePath -localFonts exec = - let serifR = replaceFileName exec "fonts/LinLibertine_R.svg" - serifRB = replaceFileName exec "fonts/LinLibertine_RB.svg" - serifRBI = replaceFileName exec "fonts/LinLibertine_RBI.svg" - serifRI = replaceFileName exec "fonts/LinLibertine_RI.svg" - sansR = replaceFileName exec "fonts/SourceSansPro_R.svg" - sansRB = replaceFileName exec "fonts/SourceSansPro_RB.svg" - sansRBI = replaceFileName exec "fonts/SourceSansPro_RBI.svg" - sansRI = replaceFileName exec "fonts/SourceSansPro_RI.svg" - monoR = replaceFileName exec "fonts/SourceCodePro_R.svg" - monoRB = replaceFileName exec "fonts/SourceCodePro_RB.svg" - in M.fromList - [ (("serif", FontSlantNormal, FontWeightNormal), serifR), - (("serif", FontSlantNormal, FontWeightBold), serifRB), - (("serif", FontSlantItalic, FontWeightNormal), serifRI), - (("serif", FontSlantOblique, FontWeightNormal), serifRI), - (("serif", FontSlantItalic, FontWeightBold), serifRBI), - (("serif", FontSlantOblique, FontWeightBold), serifRBI), - (("sans-serif", FontSlantNormal, FontWeightNormal), sansR), - (("sans-serif", FontSlantNormal, FontWeightBold), sansRB), - (("sans-serif", FontSlantItalic, FontWeightNormal), sansRI), - (("sans-serif", FontSlantOblique, FontWeightNormal), sansRI), - (("sans-serif", FontSlantItalic, FontWeightBold), sansRBI), - (("sans-serif", FontSlantOblique, FontWeightBold), sansRBI), - (("monospace", FontSlantNormal, FontWeightNormal), monoR), - (("monospace", FontSlantNormal, FontWeightBold), monoRB), - (("monospace", FontSlantItalic, FontWeightNormal), monoR), - (("monospace", FontSlantOblique, FontWeightNormal), monoR), - (("monospace", FontSlantItalic, FontWeightBold), monoRB), - (("monospace", FontSlantOblique, FontWeightBold), monoRB) +localFonts :: M.Map (String, FontSlant, FontWeight) FilePath +localFonts = M.fromList + [ (("serif", FontSlantNormal, FontWeightNormal), "fonts/LinLibertine_R.svg"), + (("serif", FontSlantNormal, FontWeightBold), "fonts/LinLibertine_RB.svg"), + (("serif", FontSlantItalic, FontWeightNormal), "fonts/LinLibertine_RI.svg"), + (("serif", FontSlantOblique, FontWeightNormal), "fonts/LinLibertine_RI.svg"), + (("serif", FontSlantItalic, FontWeightBold), "fonts/LinLibertine_RBI.svg"), + (("serif", FontSlantOblique, FontWeightBold), "fonts/LinLibertine_RBI.svg"), + (("sans-serif", FontSlantNormal, FontWeightNormal), "fonts/SourceSansPro_R.svg"), + (("sans-serif", FontSlantNormal, FontWeightBold), "fonts/SourceSansPro_RB.svg"), + (("sans-serif", FontSlantItalic, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), + (("sans-serif", FontSlantOblique, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), + (("sans-serif", FontSlantItalic, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), + (("sans-serif", FontSlantOblique, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), + (("monospace", FontSlantNormal, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantNormal, FontWeightBold), "fonts/SourceCodePro_RB.svg"), + (("monospace", FontSlantItalic, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantOblique, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantItalic, FontWeightBold), "fonts/SourceCodePro_RB.svg"), + (("monospace", FontSlantOblique, FontWeightBold), "fonts/SourceCodePro_RB.svg") ] From 843c575cc4ec7ea9f416849518451bc631be0e48 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 20:00:05 +0100 Subject: [PATCH 20/53] Adding separate license for fonts. --- fonts/LICENSE | 96 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 fonts/LICENSE diff --git a/fonts/LICENSE b/fonts/LICENSE new file mode 100644 index 0000000..7bfa350 --- /dev/null +++ b/fonts/LICENSE @@ -0,0 +1,96 @@ +Source Code © 2023 Adobe (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe in the United States and/or other countries. +Source Sans Copyright 2010-2020 Adobe (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe in the United States and/or other countries. +Libertine Copyright (c) 2003–2012, Philipp H. Poll (www.linuxlibertine.org | gillian at linuxlibertine.org), +with Reserved Font Name "Linux Libertine" and "Biolinum". + +All three Font Softwares are licensed under the SIL Open Font License, Version 1.1. +This license is copied below, and is also available with a FAQ at: +http://scripts.sil.org/OFL + + +----------------------------------------------------------- +SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007 +----------------------------------------------------------- + +PREAMBLE +The goals of the Open Font License (OFL) are to stimulate worldwide +development of collaborative font projects, to support the font creation +efforts of academic and linguistic communities, and to provide a free and +open framework in which fonts may be shared and improved in partnership +with others. + +The OFL allows the licensed fonts to be used, studied, modified and +redistributed freely as long as they are not sold by themselves. The +fonts, including any derivative works, can be bundled, embedded, +redistributed and/or sold with any software provided that any reserved +names are not used by derivative works. The fonts and derivatives, +however, cannot be released under any other type of license. The +requirement for fonts to remain under this license does not apply +to any document created using the fonts or their derivatives. + +DEFINITIONS +"Font Software" refers to the set of files released by the Copyright +Holder(s) under this license and clearly marked as such. This may +include source files, build scripts and documentation. + +"Reserved Font Name" refers to any names specified as such after the +copyright statement(s). + +"Original Version" refers to the collection of Font Software components as +distributed by the Copyright Holder(s). + +"Modified Version" refers to any derivative made by adding to, deleting, +or substituting -- in part or in whole -- any of the components of the +Original Version, by changing formats or by porting the Font Software to a +new environment. + +"Author" refers to any designer, engineer, programmer, technical +writer or other person who contributed to the Font Software. + +PERMISSION & CONDITIONS +Permission is hereby granted, free of charge, to any person obtaining +a copy of the Font Software, to use, study, copy, merge, embed, modify, +redistribute, and sell modified and unmodified copies of the Font +Software, subject to the following conditions: + +1) Neither the Font Software nor any of its individual components, +in Original or Modified Versions, may be sold by itself. + +2) Original or Modified Versions of the Font Software may be bundled, +redistributed and/or sold with any software, provided that each copy +contains the above copyright notice and this license. These can be +included either as stand-alone text files, human-readable headers or +in the appropriate machine-readable metadata fields within text or +binary files as long as those fields can be easily viewed by the user. + +3) No Modified Version of the Font Software may use the Reserved Font +Name(s) unless explicit written permission is granted by the corresponding +Copyright Holder. This restriction only applies to the primary font name as +presented to the users. + +4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font +Software shall not be used to promote, endorse or advertise any +Modified Version, except to acknowledge the contribution(s) of the +Copyright Holder(s) and the Author(s) or with their explicit written +permission. + +5) The Font Software, modified or unmodified, in part or in whole, +must be distributed entirely under this license, and must not be +distributed under any other license. The requirement for fonts to +remain under this license does not apply to any document created +using the Font Software. + +TERMINATION +This license becomes null and void if any of the above conditions are +not met. + +DISCLAIMER +THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT +OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE +COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL +DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM +OTHER DEALINGS IN THE FONT SOFTWARE. \ No newline at end of file From 14d64c11e89e821bf352c29d059800c80b16cad4 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 20:20:13 +0100 Subject: [PATCH 21/53] ormolu tweaks --- src/Tablebot/Plugins/Administration.hs | 10 +++---- src/Tablebot/Utility/Font.hs | 41 +++++++++++++------------- 2 files changed, 26 insertions(+), 25 deletions(-) diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index 6de41e6..05adf6e 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -95,8 +95,8 @@ listBlacklist m = requirePermission Superuser m $ do %Q ``` %Q|] - (T.concat $ map (formatPluginState len' bl) (filter (disableable . T.uncons) p)) - (formatUnknownDisabledPlugins (filter (`notElem` p) bl)) + (T.concat $ map (formatPluginState len' bl) (filter (disableable . T.uncons) p)) + (formatUnknownDisabledPlugins (filter (`notElem` p) bl)) where len' :: Int len' = maximum $ map T.length p @@ -111,8 +111,8 @@ listBlacklist m = requirePermission Superuser m $ do pack $ [s|%Q : %Q |] - (T.justifyLeft width ' ' a) - (if a `elem` bl then "DISABLED" else "ENABLED") + (T.justifyLeft width ' ' a) + (if a `elem` bl then "DISABLED" else "ENABLED") formatUnknownDisabledPlugins :: [Text] -> Text formatUnknownDisabledPlugins [] = "" formatUnknownDisabledPlugins l = @@ -121,7 +121,7 @@ listBlacklist m = requirePermission Superuser m $ do ``` %Q ```|] - (T.concat $ map (<> ("\n" :: Text)) l) + (T.concat $ map (<> ("\n" :: Text)) l) -- | @version@ identifies the . version :: EnvCommand SS diff --git a/src/Tablebot/Utility/Font.hs b/src/Tablebot/Utility/Font.hs index ed0aa13..b3d8e2d 100644 --- a/src/Tablebot/Utility/Font.hs +++ b/src/Tablebot/Utility/Font.hs @@ -33,23 +33,24 @@ makeFontMap = mapM (liftIO . loadFont) localFonts -- thanks to https://stackoverflow.com/questions/21549082/how-do-i-deploy-an-executable-using-chart-diagrams-standard-fonts-without-cabal localFonts :: M.Map (String, FontSlant, FontWeight) FilePath -localFonts = M.fromList - [ (("serif", FontSlantNormal, FontWeightNormal), "fonts/LinLibertine_R.svg"), - (("serif", FontSlantNormal, FontWeightBold), "fonts/LinLibertine_RB.svg"), - (("serif", FontSlantItalic, FontWeightNormal), "fonts/LinLibertine_RI.svg"), - (("serif", FontSlantOblique, FontWeightNormal), "fonts/LinLibertine_RI.svg"), - (("serif", FontSlantItalic, FontWeightBold), "fonts/LinLibertine_RBI.svg"), - (("serif", FontSlantOblique, FontWeightBold), "fonts/LinLibertine_RBI.svg"), - (("sans-serif", FontSlantNormal, FontWeightNormal), "fonts/SourceSansPro_R.svg"), - (("sans-serif", FontSlantNormal, FontWeightBold), "fonts/SourceSansPro_RB.svg"), - (("sans-serif", FontSlantItalic, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), - (("sans-serif", FontSlantOblique, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), - (("sans-serif", FontSlantItalic, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), - (("sans-serif", FontSlantOblique, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), - (("monospace", FontSlantNormal, FontWeightNormal), "fonts/SourceCodePro_R.svg"), - (("monospace", FontSlantNormal, FontWeightBold), "fonts/SourceCodePro_RB.svg"), - (("monospace", FontSlantItalic, FontWeightNormal), "fonts/SourceCodePro_R.svg"), - (("monospace", FontSlantOblique, FontWeightNormal), "fonts/SourceCodePro_R.svg"), - (("monospace", FontSlantItalic, FontWeightBold), "fonts/SourceCodePro_RB.svg"), - (("monospace", FontSlantOblique, FontWeightBold), "fonts/SourceCodePro_RB.svg") - ] +localFonts = + M.fromList + [ (("serif", FontSlantNormal, FontWeightNormal), "fonts/LinLibertine_R.svg"), + (("serif", FontSlantNormal, FontWeightBold), "fonts/LinLibertine_RB.svg"), + (("serif", FontSlantItalic, FontWeightNormal), "fonts/LinLibertine_RI.svg"), + (("serif", FontSlantOblique, FontWeightNormal), "fonts/LinLibertine_RI.svg"), + (("serif", FontSlantItalic, FontWeightBold), "fonts/LinLibertine_RBI.svg"), + (("serif", FontSlantOblique, FontWeightBold), "fonts/LinLibertine_RBI.svg"), + (("sans-serif", FontSlantNormal, FontWeightNormal), "fonts/SourceSansPro_R.svg"), + (("sans-serif", FontSlantNormal, FontWeightBold), "fonts/SourceSansPro_RB.svg"), + (("sans-serif", FontSlantItalic, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), + (("sans-serif", FontSlantOblique, FontWeightNormal), "fonts/SourceSansPro_RI.svg"), + (("sans-serif", FontSlantItalic, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), + (("sans-serif", FontSlantOblique, FontWeightBold), "fonts/SourceSansPro_RBI.svg"), + (("monospace", FontSlantNormal, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantNormal, FontWeightBold), "fonts/SourceCodePro_RB.svg"), + (("monospace", FontSlantItalic, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantOblique, FontWeightNormal), "fonts/SourceCodePro_R.svg"), + (("monospace", FontSlantItalic, FontWeightBold), "fonts/SourceCodePro_RB.svg"), + (("monospace", FontSlantOblique, FontWeightBold), "fonts/SourceCodePro_RB.svg") + ] From e10b04b03991145dc7e8b4e5142ebe4b563c8467 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 21:11:18 +0100 Subject: [PATCH 22/53] Removing Discord toke regex as it no longer works. --- src/Tablebot.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Tablebot.hs b/src/Tablebot.hs index 10d4b5d..09fe4a6 100644 --- a/src/Tablebot.hs +++ b/src/Tablebot.hs @@ -55,7 +55,6 @@ import Tablebot.Plugins (addAdministrationPlugin) import Tablebot.Utility import Tablebot.Utility.Font (makeFontMap) import Tablebot.Utility.Help (generateHelp) -import Text.Regex.PCRE ((=~)) import UnliftIO.Concurrent -- | runTablebotWithEnv @plugins@ runs the bot using data found in the .env @@ -72,8 +71,6 @@ runTablebotWithEnv plugins config = do _ <- swapMVar rFlag Reload loadEnv dToken <- pack <$> getEnv "DISCORD_TOKEN" - unless (encodeUtf8 dToken =~ ("^[A-Za-z0-9_-]{24}[.][A-Za-z0-9_-]{6}[.][A-Za-z0-9_-]{38}$" :: String)) $ - die "Invalid token format. Please check it is a bot token" prefix <- pack . fromMaybe "!" <$> lookupEnv "PREFIX" dbpath <- getEnv "SQLITE_FILENAME" runTablebot vInfo dToken prefix dbpath (addAdministrationPlugin rFlag plugins) config From 3d5ce5177a2fe0663ee95e3f5b0d48faa2a1db61 Mon Sep 17 00:00:00 2001 From: Bongo50 <69035542+Bongo50@users.noreply.github.com> Date: Wed, 10 Sep 2025 22:04:22 +0100 Subject: [PATCH 23/53] Updating Ormolu workflow --- .github/workflows/main.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml index 67ddbea..f883b80 100644 --- a/.github/workflows/main.yml +++ b/.github/workflows/main.yml @@ -17,8 +17,8 @@ jobs: ormolu: runs-on: ubuntu-latest steps: - - uses: actions/checkout@v3 - - uses: mrkkrp/ormolu-action@v4 + - uses: actions/checkout@v4 + - uses: haskell-actions/run-ormolu@v17 build: name: Build Docker Image From e1bb1aed588a2a569d593af7adf6c86bf17e4c6a Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 22:33:09 +0100 Subject: [PATCH 24/53] Various ormolu formatting tweaks --- src/Tablebot/Internal/Administration.hs | 2 +- src/Tablebot/Internal/Permission.hs | 2 +- src/Tablebot/Plugins/Administration.hs | 10 ++--- src/Tablebot/Plugins/Alias.hs | 3 +- src/Tablebot/Plugins/Netrunner/Plugin.hs | 4 +- .../Plugins/Netrunner/Type/BanList.hs | 13 +++--- src/Tablebot/Plugins/Netrunner/Type/Card.hs | 3 +- src/Tablebot/Plugins/Netrunner/Type/Cycle.hs | 3 +- .../Plugins/Netrunner/Type/Faction.hs | 3 +- src/Tablebot/Plugins/Netrunner/Type/Pack.hs | 3 +- src/Tablebot/Plugins/Netrunner/Type/Type.hs | 3 +- .../Plugins/Netrunner/Utility/Card.hs | 3 +- src/Tablebot/Plugins/Ping.hs | 3 +- src/Tablebot/Plugins/Quote.hs | 34 +++++++------- src/Tablebot/Plugins/Roll/Dice/DiceData.hs | 2 +- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 8 ++-- .../Plugins/Roll/Dice/DiceFunctions.hs | 44 +++++++++---------- src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs | 32 +++++++++----- src/Tablebot/Plugins/Roll/Dice/DiceStats.hs | 8 ++-- .../Plugins/Roll/Dice/DiceStatsBase.hs | 4 +- src/Tablebot/Utility/Database.hs | 4 +- src/Tablebot/Utility/Discord.hs | 4 +- src/Tablebot/Utility/Embed.hs | 16 +++---- src/Tablebot/Utility/Exception.hs | 15 ++++--- src/Tablebot/Utility/Parser.hs | 2 +- src/Tablebot/Utility/Permission.hs | 2 +- src/Tablebot/Utility/Random.hs | 2 +- src/Tablebot/Utility/Search.hs | 2 +- .../Utility/SmartParser/Interactions.hs | 3 +- .../Utility/SmartParser/SmartParser.hs | 12 ++--- src/Tablebot/Utility/Utils.hs | 4 +- 31 files changed, 136 insertions(+), 117 deletions(-) diff --git a/src/Tablebot/Internal/Administration.hs b/src/Tablebot/Internal/Administration.hs index 7d5ba55..8c05139 100644 --- a/src/Tablebot/Internal/Administration.hs +++ b/src/Tablebot/Internal/Administration.hs @@ -32,7 +32,7 @@ PluginBlacklist deriving Show |] -currentBlacklist :: MonadIO m => SqlPersistT m [Text] +currentBlacklist :: (MonadIO m) => SqlPersistT m [Text] currentBlacklist = do bl <- selectList allBlacklisted [] return $ fmap (pack . pluginBlacklistLabel . entityVal) bl diff --git a/src/Tablebot/Internal/Permission.hs b/src/Tablebot/Internal/Permission.hs index 0bc498c..2be6df6 100644 --- a/src/Tablebot/Internal/Permission.hs +++ b/src/Tablebot/Internal/Permission.hs @@ -63,7 +63,7 @@ permsFromGroups debug krls gps = -- debug <- liftIO isDebug -- return $ permsFromGroups debug knownroles $ getMemberGroups member -getSenderPermission :: Context m => m -> EnvDatabaseDiscord s UserPermission +getSenderPermission :: (Context m) => m -> EnvDatabaseDiscord s UserPermission getSenderPermission m = do let member = contextMember m knownroles <- liftIO getKnownRoles diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index 05adf6e..6de41e6 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -95,8 +95,8 @@ listBlacklist m = requirePermission Superuser m $ do %Q ``` %Q|] - (T.concat $ map (formatPluginState len' bl) (filter (disableable . T.uncons) p)) - (formatUnknownDisabledPlugins (filter (`notElem` p) bl)) + (T.concat $ map (formatPluginState len' bl) (filter (disableable . T.uncons) p)) + (formatUnknownDisabledPlugins (filter (`notElem` p) bl)) where len' :: Int len' = maximum $ map T.length p @@ -111,8 +111,8 @@ listBlacklist m = requirePermission Superuser m $ do pack $ [s|%Q : %Q |] - (T.justifyLeft width ' ' a) - (if a `elem` bl then "DISABLED" else "ENABLED") + (T.justifyLeft width ' ' a) + (if a `elem` bl then "DISABLED" else "ENABLED") formatUnknownDisabledPlugins :: [Text] -> Text formatUnknownDisabledPlugins [] = "" formatUnknownDisabledPlugins l = @@ -121,7 +121,7 @@ listBlacklist m = requirePermission Superuser m $ do ``` %Q ```|] - (T.concat $ map (<> ("\n" :: Text)) l) + (T.concat $ map (<> ("\n" :: Text)) l) -- | @version@ identifies the . version :: EnvCommand SS diff --git a/src/Tablebot/Plugins/Alias.hs b/src/Tablebot/Plugins/Alias.hs index d0cee7b..c7cef93 100644 --- a/src/Tablebot/Plugins/Alias.hs +++ b/src/Tablebot/Plugins/Alias.hs @@ -119,7 +119,8 @@ aliasList :: AliasType -> Message -> DatabaseDiscord () aliasList at m = do aliases <- fmap Sql.entityVal <$> liftSql (Sql.selectList [AliasType Sql.==. at] []) let msg = - aliasTypeToText at <> " aliases:\n" + aliasTypeToText at + <> " aliases:\n" <> T.unlines (map (\(Alias a b _) -> "\t`" <> a <> "` -> `" <> b <> "`") aliases) sendMessage m msg diff --git a/src/Tablebot/Plugins/Netrunner/Plugin.hs b/src/Tablebot/Plugins/Netrunner/Plugin.hs index cf18c49..3c2d297 100644 --- a/src/Tablebot/Plugins/Netrunner/Plugin.hs +++ b/src/Tablebot/Plugins/Netrunner/Plugin.hs @@ -262,7 +262,9 @@ beginnerText = do agenda <- formatFromEmojiName "agenda" rezCost <- formatFromEmojiName "rez_cost" return $ - agenda <> " **NETRUNNER** " <> rezCost + agenda + <> " **NETRUNNER** " + <> rezCost <> [r| Netrunner is an asymmetric collectable card game about hackers hacking corporations. It's run as a *free* community endeavour by NISEI: |] diff --git a/src/Tablebot/Plugins/Netrunner/Type/BanList.hs b/src/Tablebot/Plugins/Netrunner/Type/BanList.hs index 65e60a3..0c19f73 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/BanList.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/BanList.hs @@ -30,7 +30,8 @@ data BanList = BanList instance FromJSON BanList where parseJSON = withObject "BanList" $ \o -> - BanList <$> o .: "id" + BanList + <$> o .: "id" <*> o .: "date_creation" <*> o .: "date_update" <*> o .: "code" @@ -66,11 +67,11 @@ instance FromJSON CardBan where return $ maybe False (== 0) limit return $ if - | banned -> Banned - | restricted -> Restricted - | universalInfluence > 0 -> UniversalInfluence universalInfluence - | globalPenalty > 0 -> GlobalPenalty globalPenalty - | otherwise -> GlobalPenalty universalInfluence + | banned -> Banned + | restricted -> Restricted + | universalInfluence > 0 -> UniversalInfluence universalInfluence + | globalPenalty > 0 -> GlobalPenalty globalPenalty + | otherwise -> GlobalPenalty universalInfluence defaultBanList :: BanList defaultBanList = diff --git a/src/Tablebot/Plugins/Netrunner/Type/Card.hs b/src/Tablebot/Plugins/Netrunner/Type/Card.hs index 0c3345f..f242390 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/Card.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/Card.hs @@ -46,7 +46,8 @@ data Card = Card instance FromJSON Card where parseJSON = withObject "Card" $ \o -> - Card <$> o .:? "advancement_cost" + Card + <$> o .:? "advancement_cost" <*> o .:? "agenda_points" <*> o .:? "base_link" <*> o .:? "code" diff --git a/src/Tablebot/Plugins/Netrunner/Type/Cycle.hs b/src/Tablebot/Plugins/Netrunner/Type/Cycle.hs index c57eaf9..6c06fdf 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/Cycle.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/Cycle.hs @@ -25,7 +25,8 @@ data Cycle = Cycle instance FromJSON Cycle where parseJSON = withObject "Cycle" $ \o -> - Cycle <$> o .: "code" + Cycle + <$> o .: "code" <*> o .: "name" <*> o .: "position" <*> o .: "size" diff --git a/src/Tablebot/Plugins/Netrunner/Type/Faction.hs b/src/Tablebot/Plugins/Netrunner/Type/Faction.hs index 16f3187..330b38f 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/Faction.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/Faction.hs @@ -25,7 +25,8 @@ data Faction = Faction instance FromJSON Faction where parseJSON = withObject "Faction" $ \o -> - Faction <$> o .: "code" + Faction + <$> o .: "code" <*> o .: "color" <*> o .: "is_mini" <*> o .: "name" diff --git a/src/Tablebot/Plugins/Netrunner/Type/Pack.hs b/src/Tablebot/Plugins/Netrunner/Type/Pack.hs index 54c3692..e8b2ab9 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/Pack.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/Pack.hs @@ -24,7 +24,8 @@ data Pack = Pack instance FromJSON Pack where parseJSON = withObject "Pack" $ \o -> - Pack <$> o .: "code" + Pack + <$> o .: "code" <*> o .: "cycle_code" <*> o .: "name" <*> o .: "position" diff --git a/src/Tablebot/Plugins/Netrunner/Type/Type.hs b/src/Tablebot/Plugins/Netrunner/Type/Type.hs index 29d1bb4..a8c4531 100644 --- a/src/Tablebot/Plugins/Netrunner/Type/Type.hs +++ b/src/Tablebot/Plugins/Netrunner/Type/Type.hs @@ -25,7 +25,8 @@ data Type = Type instance FromJSON Type where parseJSON = withObject "Type" $ \o -> - Type <$> o .: "code" + Type + <$> o .: "code" <*> o .: "name" <*> o .: "position" <*> o .: "is_subtype" diff --git a/src/Tablebot/Plugins/Netrunner/Utility/Card.hs b/src/Tablebot/Plugins/Netrunner/Utility/Card.hs index 9d19ac4..cde351a 100644 --- a/src/Tablebot/Plugins/Netrunner/Utility/Card.hs +++ b/src/Tablebot/Plugins/Netrunner/Utility/Card.hs @@ -165,7 +165,8 @@ toReleaseData api card = fromMaybe "" helper x -> " (universal influence: " <> pack (show x) <> ")" legality = rotation <> banStatus <> restriction <> globalPenalty <> universalInf expansion = - Cycle.name c <> legality + Cycle.name c + <> legality <> if Pack.name p /= Cycle.name c then " • " <> Pack.name p else "" diff --git a/src/Tablebot/Plugins/Ping.hs b/src/Tablebot/Plugins/Ping.hs index 247ff4a..3c430a0 100644 --- a/src/Tablebot/Plugins/Ping.hs +++ b/src/Tablebot/Plugins/Ping.hs @@ -25,8 +25,7 @@ ping :: Command ping = Command "ping" - ( parseComm $ echo "pong" - ) + (parseComm $ echo "pong") [] pingHelp :: HelpPage diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index 01a4f2c..33d53b6 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -72,10 +72,10 @@ quoteReactionAdd = ReactionAdd quoteReaction where quoteReaction ri | emojiName (reactionEmoji ri) == "\x1F4AC" = do - m <- getMessage (reactionChannelId ri) (reactionMessageId ri) - case m of - Left _ -> pure () - Right mes -> addMessageQuote (reactionUserId ri) mes mes >>= sendCustomMessage mes + m <- getMessage (reactionChannelId ri) (reactionMessageId ri) + case m of + Left _ -> pure () + Right mes -> addMessageQuote (reactionUserId ri) mes mes >>= sendCustomMessage mes | otherwise = return () -- | Our quote command, which combines various functions to create, display and update quotes. @@ -172,7 +172,7 @@ randomQuote = Command "random" (parseComm randomComm) [] -- | @showQuote@, which looks for a message of the form @!quote show n@, looks -- that quote up in the database and responds with that quote. -showQ :: Context m => Int64 -> m -> DatabaseDiscord MessageDetails +showQ :: (Context m) => Int64 -> m -> DatabaseDiscord MessageDetails showQ qId m = do qu <- get $ toSqlKey qId case qu of @@ -181,7 +181,7 @@ showQ qId m = do -- | @randomQuote@, which looks for a message of the form @!quote random@, -- selects a random quote from the database and responds with that quote. -randomQ :: Context m => m -> DatabaseDiscord MessageDetails +randomQ :: (Context m) => m -> DatabaseDiscord MessageDetails randomQ = filteredRandomQuote [] "Couldn't find any quotes!" (Just randomButton) where randomButton = mkButton "Random quote" "quote random" @@ -191,7 +191,7 @@ randomQuoteComponentRecv = ComponentRecv "random" (processComponentInteraction ( -- | @authorQuote@, which looks for a message of the form @!quote author u@, -- selects a random quote from the database attributed to u and responds with that quote. -authorQ :: Context m => Text -> m -> DatabaseDiscord MessageDetails +authorQ :: (Context m) => Text -> m -> DatabaseDiscord MessageDetails authorQ t = filteredRandomQuote [QuoteAuthor ==. t] "Couldn't find any quotes with that author!" (Just authorButton) where authorButton = mkButton "Random author quote" ("quote author " <> t) @@ -202,7 +202,7 @@ authorQuoteComponentRecv = ComponentRecv "author" (processComponentInteraction ( -- | @filteredRandomQuote@ selects a random quote that meets a -- given criteria, and returns that as the response, sending the user a message if the -- quote cannot be found. -filteredRandomQuote :: Context m => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails +filteredRandomQuote :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuote' quoteFilter errorMessage mb m) catchBot' where catchBot' (GenericException "quote exception" _) = return $ (messageDetailsBasic errorMessage) {messageDetailsEmbeds = Just [], messageDetailsComponents = Just []} @@ -211,7 +211,7 @@ filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuot -- | @filteredRandomQuote'@ selects a random quote that meets a -- given criteria, and returns that as the response, throwing an exception if something -- goes wrong. -filteredRandomQuote' :: Context m => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails +filteredRandomQuote' :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails filteredRandomQuote' quoteFilter errorMessage mb m = do num <- count quoteFilter if num == 0 -- we can't find any quotes meeting the filter @@ -230,7 +230,7 @@ filteredRandomQuote' quoteFilter errorMessage mb m = do addQ :: Text -> Text -> Message -> DatabaseDiscord MessageDetails addQ qu author m = fst <$> addQ' qu author (toMention $ messageAuthor m) (messageId m) (messageChannelId m) m -addQ' :: Context m => Text -> Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord (MessageDetails, Int64) +addQ' :: (Context m) => Text -> Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord (MessageDetails, Int64) addQ' qu author requestor sourceMsg sourceChannel m = do now <- liftIO $ systemToUTCTime <$> getSystemTime let new = Quote qu author requestor (fromIntegral sourceMsg) (fromIntegral sourceChannel) now @@ -253,7 +253,7 @@ thisQ m = do Nothing -> sendMessage m "Unable to add quote" -- | @addMessageQuote@, adds a message as a quote to the database, checking that it passes the relevant tests -addMessageQuote :: Context m => UserId -> Message -> m -> DatabaseDiscord MessageDetails +addMessageQuote :: (Context m) => UserId -> Message -> m -> DatabaseDiscord MessageDetails addMessageQuote submitter q' m = do num <- count [QuoteMsgId ==. fromIntegral (messageId q')] if num == 0 @@ -281,7 +281,7 @@ addMessageQuote submitter q' m = do editQ :: Int64 -> Text -> Text -> Message -> DatabaseDiscord () editQ qId qu author m = editQ' qId (Just qu) (Just author) (toMention $ messageAuthor m) (fromIntegral $ messageId m) (fromIntegral $ messageChannelId m) m >>= sendCustomMessage m -editQ' :: Context m => Int64 -> Maybe Text -> Maybe Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord MessageDetails +editQ' :: (Context m) => Int64 -> Maybe Text -> Maybe Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord MessageDetails editQ' qId qu author requestor mid cid m = requirePermission Any m $ let k = toSqlKey qId @@ -309,10 +309,10 @@ deleteQ qId m = sendMessage m "Quote deleted" Nothing -> sendMessage m "Couldn't delete that quote!" -renderQuoteMessage :: Context m => Quote -> Int64 -> Maybe Button -> m -> DatabaseDiscord MessageDetails +renderQuoteMessage :: (Context m) => Quote -> Int64 -> Maybe Button -> m -> DatabaseDiscord MessageDetails renderQuoteMessage = renderCustomQuoteMessage "" -renderCustomQuoteMessage :: Context m => Text -> Quote -> Int64 -> Maybe Button -> m -> DatabaseDiscord MessageDetails +renderCustomQuoteMessage :: (Context m) => Text -> Quote -> Int64 -> Maybe Button -> m -> DatabaseDiscord MessageDetails renderCustomQuoteMessage t (Quote txt author submitter msgId cnlId dtm) qId mb m = do guild <- contextGuildId m let link = getLink guild @@ -396,13 +396,11 @@ quoteApplicationCommandRecv "author" -> handleNothing (getValue "author" vals >>= stringFromOptionValue) - ( \author -> authorQ author i >>= interactionResponseCustomMessage i - ) + (\author -> authorQ author i >>= interactionResponseCustomMessage i) "show" -> handleNothing (getValue "id" vals >>= integerFromOptionValue) - ( \showid -> showQ (fromIntegral showid) i >>= interactionResponseCustomMessage i - ) + (\showid -> showQ (fromIntegral showid) i >>= interactionResponseCustomMessage i) "add" -> handleNothing ((getValue "quote" vals >>= stringFromOptionValue) >>= \q -> (getValue "author" vals >>= stringFromOptionValue) <&> (q,)) diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs index bb9d2e9..cd164ca 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs @@ -127,7 +127,7 @@ data AdvancedOrdering = Not AdvancedOrdering | OrderingId Ordering | And [Advanc deriving (Show, Eq, Ord) -- | Compare two values according an advanced ordering. -applyCompare :: Ord a => AdvancedOrdering -> a -> a -> Bool +applyCompare :: (Ord a) => AdvancedOrdering -> a -> a -> Bool applyCompare (OrderingId o) a b = o == compare a b applyCompare (And os) a b = all (\o -> applyCompare o a b) os applyCompare (Or os) a b = any (\o -> applyCompare o a b) os diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index c4ec7aa..645ae8f 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -170,12 +170,12 @@ class IOEvalList a where -- it took. If the `a` value is a dice value, the values of the dice should be -- displayed. This function adds the current location to the exception -- callstack. - evalShowL :: ParseShow a => a -> ProgramStateM ([(Integer, Text)], Maybe Text) + evalShowL :: (ParseShow a) => a -> ProgramStateM ([(Integer, Text)], Maybe Text) evalShowL a = do (is, mt) <- propagateException (parseShow a) (evalShowL' a) return (genericTake maximumListLength is, mt) - evalShowL' :: ParseShow a => a -> ProgramStateM ([(Integer, Text)], Maybe Text) + evalShowL' :: (ParseShow a) => a -> ProgramStateM ([(Integer, Text)], Maybe Text) evalArgValue :: ArgValue -> ProgramStateM ListInteger evalArgValue (AVExpr e) = do @@ -216,10 +216,10 @@ class IOEval a where -- value, and the number of RNG calls it took. If the `a` value is a dice -- value, the values of the dice should be displayed. This function adds -- the current location to the exception callstack. - evalShow :: ParseShow a => a -> ProgramStateM (Integer, Text) + evalShow :: (ParseShow a) => a -> ProgramStateM (Integer, Text) evalShow a = propagateException (parseShow a) (evalShow' a) - evalShow' :: ParseShow a => a -> ProgramStateM (Integer, Text) + evalShow' :: (ParseShow a) => a -> ProgramStateM (Integer, Text) instance IOEval Base where evalShow' (NBase nb) = evalShow nb diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceFunctions.hs b/src/Tablebot/Plugins/Roll/Dice/DiceFunctions.hs index e85b1b0..41be9b8 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceFunctions.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceFunctions.hs @@ -48,16 +48,16 @@ integerFunctionsList = M.keys integerFunctions -- for each function that returns an integer. integerFunctions' :: [FuncInfo] integerFunctions' = - funcInfoIndex : - constructFuncInfo "length" (genericLength @Integer @Integer) : - constructFuncInfo "sum" (sum @[] @Integer) : - constructFuncInfo "max" (max @Integer) : - constructFuncInfo "min" (min @Integer) : - constructFuncInfo "maximum" (maximum @[] @Integer) : - constructFuncInfo "minimum" (minimum @[] @Integer) : - constructFuncInfo' "mod" (mod @Integer) (Nothing, Nothing, (== 0)) : - constructFuncInfo' "fact" fact (Nothing, Just factorialLimit, const False) : - (uncurry constructFuncInfo <$> [("abs", abs @Integer), ("id", id), ("neg", negate)]) + funcInfoIndex + : constructFuncInfo "length" (genericLength @Integer @Integer) + : constructFuncInfo "sum" (sum @[] @Integer) + : constructFuncInfo "max" (max @Integer) + : constructFuncInfo "min" (min @Integer) + : constructFuncInfo "maximum" (maximum @[] @Integer) + : constructFuncInfo "minimum" (minimum @[] @Integer) + : constructFuncInfo' "mod" (mod @Integer) (Nothing, Nothing, (== 0)) + : constructFuncInfo' "fact" fact (Nothing, Just factorialLimit, const False) + : (uncurry constructFuncInfo <$> [("abs", abs @Integer), ("id", id), ("neg", negate)]) where fact n | n < 0 = 0 @@ -77,15 +77,15 @@ listFunctionsList = M.keys listFunctions -- each function that returns an integer. listFunctions' :: [FuncInfoBase [Integer]] listFunctions' = - funcInfoInsert : - constructFuncInfo "prepend" (:) : - constructFuncInfo "replicate" (genericReplicate @Integer) : - funcInfoSet : - constructFuncInfo "concat" (++) : - constructFuncInfo "between" between : - constructFuncInfo "drop" (genericDrop @Integer) : - constructFuncInfo "take" (genericTake @Integer) : - (uncurry constructFuncInfo <$> [("sort", sort), ("reverse", reverse)]) + funcInfoInsert + : constructFuncInfo "prepend" (:) + : constructFuncInfo "replicate" (genericReplicate @Integer) + : funcInfoSet + : constructFuncInfo "concat" (++) + : constructFuncInfo "between" between + : constructFuncInfo "drop" (genericDrop @Integer) + : constructFuncInfo "take" (genericTake @Integer) + : (uncurry constructFuncInfo <$> [("sort", sort), ("reverse", reverse)]) where between i i' = let (mi, ma, rev) = (min i i', max i i', if i > i' then reverse else id) in rev [mi .. ma] @@ -170,10 +170,10 @@ instance ArgCount Integer where instance ArgCount [Integer] where getTypes _ = [ATIntegerList] -instance ArgCount f => ArgCount (Integer -> f) where +instance (ArgCount f) => ArgCount (Integer -> f) where getTypes _ = ATInteger : getTypes (Proxy :: Proxy f) -instance ArgCount f => ArgCount ([Integer] -> f) where +instance (ArgCount f) => ArgCount ([Integer] -> f) where getTypes _ = ATIntegerList : getTypes (Proxy :: Proxy f) -- | Type class which represents applying a function f to some inputs when given @@ -181,7 +181,7 @@ instance ArgCount f => ArgCount ([Integer] -> f) where -- -- If the number of inputs is incorrect or the value given out of the range, an -- exception is thrown. -class ArgCount f => ApplyFunc f where +class (ArgCount f) => ApplyFunc f where -- | Takes a function, the number of arguments in the function overall, bounds -- on integer values to the function, and a list of `ListInteger`s (which are -- either a list of integers or an integer), and returns a wrapped `j` value, diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs index e9462cc..f8f8905 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceParsing.hs @@ -40,7 +40,7 @@ failure' s ss = failure (Just $ Tokens $ NE.fromList $ T.unpack s) (S.map (Token variableName :: Parser T.Text variableName = T.pack <$> some (choice $ char <$> '_' : ['a' .. 'z']) -instance CanParse a => CanParse (Var a) where +instance (CanParse a) => CanParse (Var a) where pars = do _ <- try (string "var") <* skipSpace letCon <- try (char '!' $> VarLazy) <|> return Var @@ -87,9 +87,11 @@ instance CanParse ListValues where do functionParser listFunctions LVFunc <|> (LVVar . ("l_" <>) <$> try (string "l_" *> variableName)) - <|> ListValuesMisc <$> (pars >>= checkVar) - <|> (try (pars <* char '#') >>= \nb -> MultipleValues nb <$> pars) - <|> LVBase <$> pars + <|> ListValuesMisc + <$> (pars >>= checkVar) + <|> (try (pars <* char '#') >>= \nb -> MultipleValues nb <$> pars) + <|> LVBase + <$> pars where checkVar (MiscVar l) | T.isPrefixOf "l_" (varName l) = return (MiscVar l) @@ -104,7 +106,8 @@ instance CanParse ListValuesBase where <* skipSpace <* (char '}' "could not find closing brace for list") ) - <|> LVBParen . unnest + <|> LVBParen + . unnest <$> pars where unnest (Paren (LVBase (LVBParen e))) = e @@ -121,7 +124,7 @@ instance (CanParse b) => CanParse (If b) where e <- string "else" *> skipSpace1 *> pars return $ If a t e -instance CanParse a => CanParse (MiscData a) where +instance (CanParse a) => CanParse (MiscData a) where pars = (MiscVar <$> pars) <|> (MiscIf <$> pars) instance CanParse Expr where @@ -156,8 +159,11 @@ functionParser m mainCons = instance CanParse Negation where pars = - try (char '-') *> skipSpace *> (Neg <$> pars) - <|> NoNeg <$> pars + try (char '-') + *> skipSpace + *> (Neg <$> pars) + <|> NoNeg + <$> pars instance CanParse Expo where pars = do @@ -167,7 +173,8 @@ instance CanParse Expo where instance CanParse NumBase where pars = (NBParen . unnest <$> pars) - <|> Value <$> integer "could not parse integer" + <|> Value + <$> integer "could not parse integer" where unnest (Paren (NoExpr (NoTerm (NoNeg (NoExpo (NoFunc (NBase (NBParen e)))))))) = e unnest e = e @@ -182,8 +189,9 @@ instance CanParse Base where (DiceBase <$> parseDice nb) <|> return (NBase nb) ) - <|> DiceBase <$> parseDice (Value 1) - <|> (NumVar <$> try variableName) + <|> DiceBase + <$> parseDice (Value 1) + <|> (NumVar <$> try variableName) instance CanParse Die where pars = do @@ -282,7 +290,7 @@ instance ParseShow ListValuesBase where parseShow (LVBList es) = "{" <> T.intercalate ", " (parseShow <$> es) <> "}" parseShow (LVBParen p) = parseShow p -instance ParseShow a => ParseShow (MiscData a) where +instance (ParseShow a) => ParseShow (MiscData a) where parseShow (MiscVar l) = parseShow l parseShow (MiscIf l) = parseShow l diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs index 473fdd8..f33789c 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs @@ -76,7 +76,7 @@ rangeListValues lv = do -- has a variety of functions that operate on them. -- -- An `Data.Distribution.Experiment` is a monadic form of this. -class ParseShow a => Range a where +class (ParseShow a) => Range a where -- | Try and get the `Experiment` of the given value, throwing a -- `MonadException` on failure. range :: (MonadException m, ParseShow a) => a -> m Experiment @@ -190,7 +190,7 @@ rangeDiceExperiment die (Just (DieOpRecur doo mdor)) is = rangeDieOpExperiment d -- | Perform one dice operation on the given `Experiment`, possibly returning -- a modified experiment representing the distribution of dice rolls. -rangeDieOpExperiment :: MonadException m => Experiment -> DieOpOption -> ExperimentList -> m ExperimentList +rangeDieOpExperiment :: (MonadException m) => Experiment -> DieOpOption -> ExperimentList -> m ExperimentList rangeDieOpExperiment die (DieOpOptionLazy o) is = rangeDieOpExperiment die o is rangeDieOpExperiment _ (DieOpOptionKD kd lhw) is = rangeDieOpExperimentKD kd lhw is rangeDieOpExperiment die (Reroll rro cond lim) is = do @@ -241,7 +241,7 @@ rangeDieOpExperimentKD kd lhw is = do -- -- Only used within `DiceStats` as I have no interest in producing statistics on -- lists -class ParseShow a => RangeList a where +class (ParseShow a) => RangeList a where -- | Try and get the `DistributionList` of the given value, throwing a -- `MonadException` on failure. rangeList :: (MonadException m, ParseShow a) => a -> m ExperimentList @@ -268,7 +268,7 @@ instance RangeList ListValues where rangeList' (ListValuesMisc m) = rangeList m rangeList' b@(LVVar _) = evaluationException "cannot find range of variable" [parseShow b] -rangeArgValue :: MonadException m => ArgValue -> m (D.Experiment ListInteger) +rangeArgValue :: (MonadException m) => ArgValue -> m (D.Experiment ListInteger) rangeArgValue (AVExpr e) = (LIInteger <$>) <$> range e rangeArgValue (AVListValues lv) = (LIList <$>) <$> rangeList lv diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs index fbb7ff2..c8d031e 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs @@ -41,14 +41,14 @@ diagramX, diagramY :: Double -- | Get the ByteString representation of the given distribution, setting the -- string as its title. -distributionByteString :: MonadException m => FontMap Double -> [(Distribution, T.Text)] -> m B.ByteString +distributionByteString :: (MonadException m) => FontMap Double -> [(Distribution, T.Text)] -> m B.ByteString distributionByteString fontMap d = encodePng . renderDia Rasterific opts <$> distributionDiagram fontMap d where opts = RasterificOptions (dims2D diagramX diagramY) -- | Get the Diagram representation of the given distribution, setting the -- string as its title. -distributionDiagram :: MonadException m => FontMap Double -> [(Distribution, T.Text)] -> m (Diagram B) +distributionDiagram :: (MonadException m) => FontMap Double -> [(Distribution, T.Text)] -> m (Diagram B) distributionDiagram fontMap d = do if null d then evaluationException "empty distribution" [] diff --git a/src/Tablebot/Utility/Database.hs b/src/Tablebot/Utility/Database.hs index d8d660f..2c3c5b3 100644 --- a/src/Tablebot/Utility/Database.hs +++ b/src/Tablebot/Utility/Database.hs @@ -51,10 +51,10 @@ delete r = liftSql $ Sql.delete r deleteBy :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Unique record -> EnvDatabaseDiscord d () deleteBy r = liftSql $ Sql.deleteBy r -deleteCascade :: Sql.DeleteCascade record Sql.SqlBackend => Sql.Key record -> EnvDatabaseDiscord d () +deleteCascade :: (Sql.DeleteCascade record Sql.SqlBackend) => Sql.Key record -> EnvDatabaseDiscord d () deleteCascade r = liftSql $ Sql.deleteCascade r -deleteCascadeWhere :: Sql.DeleteCascade record Sql.SqlBackend => [Sql.Filter record] -> EnvDatabaseDiscord d () +deleteCascadeWhere :: (Sql.DeleteCascade record Sql.SqlBackend) => [Sql.Filter record] -> EnvDatabaseDiscord d () deleteCascadeWhere r = liftSql $ Sql.deleteCascadeWhere r deleteWhereCount :: (Sql.PersistEntity val, Sql.PersistEntityBackend val ~ Sql.SqlBackend) => [Sql.Filter val] -> EnvDatabaseDiscord d Int64 diff --git a/src/Tablebot/Utility/Discord.hs b/src/Tablebot/Utility/Discord.hs index a562608..883c899 100644 --- a/src/Tablebot/Utility/Discord.hs +++ b/src/Tablebot/Utility/Discord.hs @@ -152,7 +152,7 @@ sendCustomReplyMessage m mid fail' t = do -- If you suffer from nightmares, don't look in 'Tablebot.Handler.Embed'. Nothing good lives there. -- In the future, I may actually submit a PR to discord-haskell with a fix to allow colours properly. sendEmbedMessage :: - Embeddable e => + (Embeddable e) => Message -> Text -> e -> @@ -160,7 +160,7 @@ sendEmbedMessage :: sendEmbedMessage m = sendChannelEmbedMessage (messageChannelId m) sendChannelEmbedMessage :: - Embeddable e => + (Embeddable e) => ChannelId -> Text -> e -> diff --git a/src/Tablebot/Utility/Embed.hs b/src/Tablebot/Utility/Embed.hs index b940baf..72c792a 100644 --- a/src/Tablebot/Utility/Embed.hs +++ b/src/Tablebot/Utility/Embed.hs @@ -20,49 +20,49 @@ import Tablebot.Internal.Embed (Embeddable, asEmbed) simpleEmbed :: Text -> CreateEmbed simpleEmbed t = CreateEmbed "" "" Nothing "" "" Nothing t [] Nothing "" Nothing Nothing Nothing -addTitle :: Embeddable e => Text -> e -> CreateEmbed +addTitle :: (Embeddable e) => Text -> e -> CreateEmbed addTitle t e = (asEmbed e) { createEmbedTitle = t } -addFooter :: Embeddable e => Text -> e -> CreateEmbed +addFooter :: (Embeddable e) => Text -> e -> CreateEmbed addFooter t e = (asEmbed e) { createEmbedFooterText = t } -addTimestamp :: Embeddable e => UTCTime -> e -> CreateEmbed +addTimestamp :: (Embeddable e) => UTCTime -> e -> CreateEmbed addTimestamp t e = (asEmbed e) { createEmbedTimestamp = Just t } -addAuthor :: Embeddable e => Text -> e -> CreateEmbed +addAuthor :: (Embeddable e) => Text -> e -> CreateEmbed addAuthor t e = (asEmbed e) { createEmbedAuthorName = t } -addLink :: Embeddable e => Text -> e -> CreateEmbed +addLink :: (Embeddable e) => Text -> e -> CreateEmbed addLink t e = (asEmbed e) { createEmbedUrl = t } -addColour :: Embeddable e => DiscordColor -> e -> CreateEmbed +addColour :: (Embeddable e) => DiscordColor -> e -> CreateEmbed addColour c e = (asEmbed e) { createEmbedColor = Just c } -addImage :: Embeddable e => Text -> e -> CreateEmbed +addImage :: (Embeddable e) => Text -> e -> CreateEmbed addImage url e = (asEmbed e) { createEmbedImage = Just $ CreateEmbedImageUrl url } -addThumbnail :: Embeddable e => Text -> e -> CreateEmbed +addThumbnail :: (Embeddable e) => Text -> e -> CreateEmbed addThumbnail url e = (asEmbed e) { createEmbedThumbnail = Just $ CreateEmbedImageUrl url diff --git a/src/Tablebot/Utility/Exception.hs b/src/Tablebot/Utility/Exception.hs index 46396fc..d5552bb 100644 --- a/src/Tablebot/Utility/Exception.hs +++ b/src/Tablebot/Utility/Exception.hs @@ -45,20 +45,20 @@ data BotException instance Exception BotException -- | Aliases for throw and catch that enforce the exception type. -throwBot :: MonadException m => BotException -> m a +throwBot :: (MonadException m) => BotException -> m a throwBot = throw -catchBot :: MonadException m => m a -> (BotException -> m a) -> m a +catchBot :: (MonadException m) => m a -> (BotException -> m a) -> m a catchBot = catch -- | @transformException@ takes a computation m that may fail, catches any -- exception it throws, and transforms it into a new one with transformer. -transformException :: MonadException m => m a -> (BotException -> BotException) -> m a +transformException :: (MonadException m) => m a -> (BotException -> BotException) -> m a transformException m transformer = m `catchBot` (throwBot . transformer) -- | @transformExceptionConst@ takes a computation m that may fail and replaces -- any exception it throws with the constant exception e. -transformExceptionConst :: MonadException m => m a -> BotException -> m a +transformExceptionConst :: (MonadException m) => m a -> BotException -> m a transformExceptionConst m e = m `catchBot` \_ -> throwBot e -- | @errorEmoji@ defines a Discord emoji in plaintext for use in error outputs. @@ -69,7 +69,12 @@ errorEmoji = ":warning:" -- Discord. formatUserError :: String -> String -> String formatUserError name' message = - errorEmoji ++ " **" ++ name' ++ "** " ++ errorEmoji ++ "\n" + errorEmoji + ++ " **" + ++ name' + ++ "** " + ++ errorEmoji + ++ "\n" ++ "An error was encountered while resolving your command:\n" ++ "> `" ++ message diff --git a/src/Tablebot/Utility/Parser.hs b/src/Tablebot/Utility/Parser.hs index 318beef..f50b327 100644 --- a/src/Tablebot/Utility/Parser.hs +++ b/src/Tablebot/Utility/Parser.hs @@ -167,7 +167,7 @@ double = do _ <- char '.' num <- some digit return $ '.' : num - ) + ) <|> return "" return (read (minus : digits ++ decimal)) diff --git a/src/Tablebot/Utility/Permission.hs b/src/Tablebot/Utility/Permission.hs index 3750742..fa959e1 100644 --- a/src/Tablebot/Utility/Permission.hs +++ b/src/Tablebot/Utility/Permission.hs @@ -14,7 +14,7 @@ import Tablebot.Utility.Exception (BotException (PermissionException), throwBot) import Tablebot.Utility.Types -- | @requirePermission@ only runs the inputted effect if permissions are matched. Otherwise it returns an error. -requirePermission :: Context m => RequiredPermission -> m -> EnvDatabaseDiscord s a -> EnvDatabaseDiscord s a +requirePermission :: (Context m) => RequiredPermission -> m -> EnvDatabaseDiscord s a -> EnvDatabaseDiscord s a requirePermission perm m a = do p <- getSenderPermission m if userHasPermission perm p diff --git a/src/Tablebot/Utility/Random.hs b/src/Tablebot/Utility/Random.hs index 68dac0a..9eee72a 100644 --- a/src/Tablebot/Utility/Random.hs +++ b/src/Tablebot/Utility/Random.hs @@ -36,7 +36,7 @@ chooseOneWeighted weight xs | any ((< 0) . weight) xs = throw $ RandomException "Probability weightings cannot be negative." | all ((== 0) . weight) xs = throw $ RandomException "At least one weighting must be positive." | otherwise = - fst . fromJust . (\i -> find ((> i) . snd) (zip xs' $ scanl1 (+) $ weight <$> xs')) <$> randomRIO (0, totalWeight - 1) + fst . fromJust . (\i -> find ((> i) . snd) (zip xs' $ scanl1 (+) $ weight <$> xs')) <$> randomRIO (0, totalWeight - 1) where xs' = filter ((> 0) . weight) xs -- removes elements with a weight of zero totalWeight = sum $ weight <$> xs' diff --git a/src/Tablebot/Utility/Search.hs b/src/Tablebot/Utility/Search.hs index 7c6f864..0bbb1c6 100644 --- a/src/Tablebot/Utility/Search.hs +++ b/src/Tablebot/Utility/Search.hs @@ -31,7 +31,7 @@ import Data.Text (Text, isInfixOf, length, take) import Text.EditDistance -- | @compareOn@ is a helper function for comparing types that aren't ord. -compareOn :: Ord b => (a -> b) -> a -> a -> Ordering +compareOn :: (Ord b) => (a -> b) -> a -> a -> Ordering compareOn comp a b = compare (comp a) (comp b) -- | @FuzzyCosts@ is a wrapper for Text.EditDistance's EditCosts data type for diff --git a/src/Tablebot/Utility/SmartParser/Interactions.hs b/src/Tablebot/Utility/SmartParser/Interactions.hs index 72ea2b0..7925ca5 100644 --- a/src/Tablebot/Utility/SmartParser/Interactions.hs +++ b/src/Tablebot/Utility/SmartParser/Interactions.hs @@ -252,8 +252,7 @@ processComponentInteraction' _ _ _ = throwBot $ InteractionException "could not onlyAllowRequestor :: forall f. (PComm f () Interaction MessageDetails) => f -> Parser (Interaction -> DatabaseDiscord MessageDetails) onlyAllowRequestor = onlyAllowRequestor' - ( (messageDetailsBasic "You don't have permission to use this component.") {messageDetailsFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral]} - ) + ((messageDetailsBasic "You don't have permission to use this component.") {messageDetailsFlags = Just $ InteractionResponseMessageFlags [InteractionResponseMessageFlagEphermeral]}) -- | Take a message to send when a user that is not the one that created a -- component, and then parse out a user id, and then get the interaction diff --git a/src/Tablebot/Utility/SmartParser/SmartParser.hs b/src/Tablebot/Utility/SmartParser/SmartParser.hs index 6a6ad34..a623854 100644 --- a/src/Tablebot/Utility/SmartParser/SmartParser.hs +++ b/src/Tablebot/Utility/SmartParser/SmartParser.hs @@ -125,7 +125,7 @@ instance CanParse Text where instance {-# OVERLAPPING #-} CanParse String where pars = word -instance IsString a => CanParse (Quoted a) where +instance (IsString a) => CanParse (Quoted a) where pars = Qu . fromString <$> quoted instance (ParseShow a) => ParseShow (Quoted a) where @@ -133,7 +133,7 @@ instance (ParseShow a) => ParseShow (Quoted a) where -- A parser for @Maybe a@ attempts to parse @a@, returning @Just x@ if -- correctly parsed, else @Nothing@. -instance CanParse a => CanParse (Maybe a) where +instance (CanParse a) => CanParse (Maybe a) where pars = optional $ try (pars @a) -- Note: we override @parsThenMoveToNext@: @@ -144,7 +144,7 @@ instance CanParse a => CanParse (Maybe a) where Just val -> Just val <$ (eof <|> skipSpace1) -- A parser for @[a]@ parses any number of @a@s. -instance {-# OVERLAPPABLE #-} CanParse a => CanParse [a] where +instance {-# OVERLAPPABLE #-} (CanParse a) => CanParse [a] where pars = many pars -- A parser for @Either a b@ attempts to parse @a@, and if that fails then @@ -183,7 +183,7 @@ instance (CanParse a, CanParse b, CanParse c, CanParse d, CanParse e) => CanPars v <- pars @e return (x, y, z, w, v) -instance KnownSymbol s => CanParse (Exactly s) where +instance (KnownSymbol s) => CanParse (Exactly s) where pars = chunk (pack $ symbolVal (Proxy :: Proxy s)) >> return Ex instance (KnownSymbol err, CanParse x) => CanParse (WithError err x) where @@ -203,10 +203,10 @@ instance CanParse () where instance CanParse Snowflake where pars = Snowflake . fromInteger <$> posInteger -instance IsString a => CanParse (RestOfInput a) where +instance (IsString a) => CanParse (RestOfInput a) where pars = ROI . fromString <$> untilEnd -instance IsString a => CanParse (RestOfInput1 a) where +instance (IsString a) => CanParse (RestOfInput1 a) where pars = ROI1 . fromString <$> untilEnd1 -- | Parse a labelled value, by parsing the base value and adding the label diff --git a/src/Tablebot/Utility/Utils.hs b/src/Tablebot/Utility/Utils.hs index 54c660a..f42bce3 100644 --- a/src/Tablebot/Utility/Utils.hs +++ b/src/Tablebot/Utility/Utils.hs @@ -30,12 +30,12 @@ isDebug = do justDebug (Just "1") = True justDebug _ = False -debugPrint :: Show a => a -> IO () +debugPrint :: (Show a) => a -> IO () debugPrint a = do d <- isDebug when d $ print a -intToText :: Integral a => a -> Text +intToText :: (Integral a) => a -> Text intToText = toStrict . toLazyText . decimal -- | @standardise@ takes converts text to lowercase and removes diacritics From bb23ad262fb6816bb6c0c5266f03602d218da69f Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 23:36:44 +0100 Subject: [PATCH 25/53] Hopefully fixing Docker issue --- Dockerfile | 3 +++ 1 file changed, 3 insertions(+) diff --git a/Dockerfile b/Dockerfile index b4479d2..5edb871 100644 --- a/Dockerfile +++ b/Dockerfile @@ -3,6 +3,9 @@ FROM haskell:8.10.7 as build RUN mkdir -p /tablebot/build WORKDIR /tablebot/build +# https://unix.stackexchange.com/a/743863 +RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list + # system lib dependencies RUN apt-get update -qq && \ apt-get install -qq -y libpcre3-dev build-essential pkg-config libicu-dev --fix-missing --no-install-recommends && \ From 7c23b72ade1ead03980dea2b8c0a622e90849c0d Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 23:39:26 +0100 Subject: [PATCH 26/53] Same idea --- Dockerfile | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Dockerfile b/Dockerfile index 5edb871..87176db 100644 --- a/Dockerfile +++ b/Dockerfile @@ -3,11 +3,9 @@ FROM haskell:8.10.7 as build RUN mkdir -p /tablebot/build WORKDIR /tablebot/build -# https://unix.stackexchange.com/a/743863 -RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list - # system lib dependencies -RUN apt-get update -qq && \ +RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ + apt-get update -qq && \ apt-get install -qq -y libpcre3-dev build-essential pkg-config libicu-dev --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* From 75f98741382236340410b50425e1adc7de9d4442 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Wed, 10 Sep 2025 23:45:59 +0100 Subject: [PATCH 27/53] Same idea, again --- Dockerfile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index 87176db..c56c5ea 100644 --- a/Dockerfile +++ b/Dockerfile @@ -19,7 +19,8 @@ RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin FROM haskell:8.10.7-slim as app # system runtime deps -RUN apt-get update -qq && \ +RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ + apt-get update -qq && \ apt-get install -qq -y libpcre3 libicu63 --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* From 4180830e5808b1de8ab8d7afe390e16b9e1a5340 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Thu, 11 Sep 2025 01:08:53 +0100 Subject: [PATCH 28/53] Removing redundant imports --- src/Tablebot/Utility/Font.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/src/Tablebot/Utility/Font.hs b/src/Tablebot/Utility/Font.hs index b3d8e2d..3cb7f78 100644 --- a/src/Tablebot/Utility/Font.hs +++ b/src/Tablebot/Utility/Font.hs @@ -9,8 +9,6 @@ import Graphics.Rendering.Chart.Backend.Diagrams (DEnv (..), createEnv) import Graphics.Rendering.Chart.Backend.Types import Graphics.SVGFonts (loadFont) import qualified Graphics.SVGFonts.ReadFont as F -import System.Environment (lookupEnv) -import System.FilePath (replaceFileName) -- | A type to map between some basic font characteristics and some loaded fonts. type FontMap n = M.Map (String, FontSlant, FontWeight) (F.PreparedFont n) From 1698e4b8dad62745f27cdf2aa13c10e6c3bb3dd9 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Thu, 11 Sep 2025 01:10:06 +0100 Subject: [PATCH 29/53] Fixing favourite command from welcome plugin on Docker --- Dockerfile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Dockerfile b/Dockerfile index c56c5ea..2d8fe70 100644 --- a/Dockerfile +++ b/Dockerfile @@ -33,4 +33,6 @@ COPY --from=build /tablebot/build/bin . COPY .git .git # we need fonts for the roll stats COPY fonts fonts +# resources folder +COPY resources resources CMD /tablebot/tablebot-exe From 6418803db83a6177b95b49951d787aa16693bcf3 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Thu, 11 Sep 2025 01:18:53 +0100 Subject: [PATCH 30/53] Increasing timeout time for dice stats --- src/Tablebot/Plugins/Roll/Plugin.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index be366dd..3c44661 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -224,8 +224,8 @@ statsCommand :: Command statsCommand = Command "stats" statsCommandParser [] where oneSecond = 1000000 - fiveSeconds = 5 * oneSecond - timeoutTime = fiveSeconds + tenSeconds = 10 * oneSecond + timeoutTime = tenSeconds statsCommandParser :: Parser (Message -> DatabaseDiscord ()) statsCommandParser = do firstE <- pars From 556e984be2ab15cc11afa1ea5d565d3d1ea2ce39 Mon Sep 17 00:00:00 2001 From: Bonngo50 Date: Thu, 11 Sep 2025 01:36:08 +0100 Subject: [PATCH 31/53] ormolu fixes --- src/Tablebot/Plugins/Roll/Dice/DiceData.hs | 4 ++-- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs index 744f62d..c232f28 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceData.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceData.hs @@ -72,7 +72,7 @@ data ListValuesBase = LVBParen (Paren ListValues) | LVBList [Expr] -- | The type for a binary operator between one or more `sub` values data BinOp sub typ where - BinOp :: Operation typ => sub -> [(typ, sub)] -> BinOp sub typ + BinOp :: (Operation typ) => sub -> [(typ, sub)] -> BinOp sub typ deriving instance (Show sub, Show typ) => Show (BinOp sub typ) @@ -85,7 +85,7 @@ pattern SingBinOp a <- -- | The type class that means we can get an operation on integers from a value. class Operation a where - getOperation :: a -> (forall n. Integral n => n -> n -> n) + getOperation :: a -> (forall n. (Integral n) => n -> n -> n) -- | The type of the top level expression. -- diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index d13d2a6..1e7faea 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -211,7 +211,7 @@ instance IOEvalList (MiscData ListValues) where -- | This type class gives a function which evaluates the value to an integer -- and a string. -class ParseShow a => IOEval a where +class (ParseShow a) => IOEval a where -- | Evaluate the given item to an integer, a string representation of the -- value, and the number of RNG calls it took. If the `a` value is a dice -- value, the values of the dice should be displayed. This function adds From 376837c4514dd83be97274b21f03699991a02178 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:06:49 +0100 Subject: [PATCH 32/53] you should commit lock files and auto-generated files --- .gitignore | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 57468f6..21e4f10 100644 --- a/.gitignore +++ b/.gitignore @@ -3,7 +3,7 @@ .env db.* database* -*.cabal -stack.yaml.lock .gitattributes .vscode +dist-newstyle/ +cabal.project.local From 55843cd9cf8893267c3ba17aa77d2a4d60c1fa4d Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:08:34 +0100 Subject: [PATCH 33/53] bump lts, remove unneeded deps, use more l0negamer deps, and commit lock and cabal file (+ cabal.project) --- cabal.project | 11 ++ stack.yaml | 34 ++---- stack.yaml.lock | 69 +++++++++++ tablebot.cabal | 307 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 397 insertions(+), 24 deletions(-) create mode 100644 cabal.project create mode 100644 stack.yaml.lock create mode 100644 tablebot.cabal diff --git a/cabal.project b/cabal.project new file mode 100644 index 0000000..8221172 --- /dev/null +++ b/cabal.project @@ -0,0 +1,11 @@ +packages: . + +source-repository-package + type: git + location: git@github.com:L0neGamer/haskell-distribution.git + tag: 569d6452e4bffedb2c0d3795885fccdb22a4d29d + +source-repository-package + type: git + location: git@github.com:L0neGamer/duckling.git + tag: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 diff --git a/stack.yaml b/stack.yaml index 619f14b..02c0628 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,8 +16,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/18.yaml +resolver: lts-24.10 # User packages to be built. # Various formats can be used as shown in the example below. @@ -39,35 +38,22 @@ packages: # - git: https://github.com/commercialhaskell/stack.git # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a # -# allow-newer: true +allow-newer: true extra-deps: -- discord-haskell-1.14.0 +- discord-haskell-1.18.0 - emoji-0.1.0.2 - load-env-0.2.1.0 -- megaparsec-9.0.1 -- persistent-2.11.0.4 -- persistent-sqlite-2.11.1.0 -- persistent-template-2.9.1.0@rev:2 -- esqueleto-3.4.1.1 -- duckling-0.2.0.0 -- dependent-sum-0.7.1.0 -- constraints-extras-0.3.1.0 -- Chart-diagrams-1.9.3 -- SVGFonts-1.7.0.1 -- diagrams-core-1.5.0 -- diagrams-lib-1.4.5.1 -- diagrams-postscript-1.5.1 -- diagrams-svg-1.4.3.1 +- persistent-2.17.1.0 - svg-builder-0.1.1 -- active-0.2.0.15 -- dual-tree-0.2.3.0 -- monoid-extras-0.6.1 -- statestack-0.3 -- diagrams-rasterific-1.4.2.2 -# - distribution-1.1.1.1 - git: https://github.com/L0neGamer/haskell-distribution.git commit: 569d6452e4bffedb2c0d3795885fccdb22a4d29d +- git: git@github.com:L0neGamer/duckling.git + commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 + +allow-newer-deps: + - duckling + - distribution # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock new file mode 100644 index 0000000..e3fb79f --- /dev/null +++ b/stack.yaml.lock @@ -0,0 +1,69 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/topics/lock_files + +packages: +- completed: + hackage: discord-haskell-1.18.0@sha256:0b88b1c391542b36243647f3533261867a1bd59cb2194519bc4b0e45b9a73797,7032 + pantry-tree: + sha256: 08c931796e4cdab60dd889f6a7f2c8cbcb72f9cdedfeee683c3a0593294073f8 + size: 3916 + original: + hackage: discord-haskell-1.18.0 +- completed: + hackage: emoji-0.1.0.2@sha256:d995572a5c7dcd28f98eb15c6e387a7b3bda1ac2477ab0d9dba8580d5d7b161f,1273 + pantry-tree: + sha256: dd9ea90a631342e5db0fc21331ade4d563a685e9125d5a3989eefa8e1b96c6c6 + size: 437 + original: + hackage: emoji-0.1.0.2 +- completed: + hackage: load-env-0.2.1.0@sha256:17628d397cf7ba6af9bf103c2c3592bb246e2ad58bd019cc5071c654887b1083,1866 + pantry-tree: + sha256: 12947042909a99d32d10cb72865db781867f34c0bd28c430091c2b80db1f1109 + size: 601 + original: + hackage: load-env-0.2.1.0 +- completed: + hackage: persistent-2.17.1.0@sha256:7750cd6e4215241a1391fceb6432eab7f21f99272ed9da2274d89696f03dc577,7096 + pantry-tree: + sha256: 1711bdf4d648fd308242fe1f525ac03d2ca0221e67539778ad95d1dd149cd0fe + size: 7182 + original: + hackage: persistent-2.17.1.0 +- completed: + hackage: svg-builder-0.1.1@sha256:1a7b9deb38cbf4be5b5271daa6cb41ece26825d14994fd77d57e9a960894bd05,1627 + pantry-tree: + sha256: 81aa683eb07ab3914088d336125f06910c42e9c7f86393191db32e5fbf40528a + size: 535 + original: + hackage: svg-builder-0.1.1 +- completed: + commit: 569d6452e4bffedb2c0d3795885fccdb22a4d29d + git: https://github.com/L0neGamer/haskell-distribution.git + name: distribution + pantry-tree: + sha256: df46a8ef68d35f55bdcf3d6c6e5578cad5680306a7bef4e52da8631cc171c1fc + size: 808 + version: 1.1.1.1 + original: + commit: 569d6452e4bffedb2c0d3795885fccdb22a4d29d + git: https://github.com/L0neGamer/haskell-distribution.git +- completed: + commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 + git: git@github.com:L0neGamer/duckling.git + name: duckling + pantry-tree: + sha256: 126902871d2ae27e2ac4a88a07f04a4c3b7bff3f0fdf067d8d9226136002ff51 + size: 77724 + version: 0.2.0.1 + original: + commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 + git: git@github.com:L0neGamer/duckling.git +snapshots: +- completed: + sha256: 057c5a66404132b661211de21bb4490f6df89c162752a17f0df5a0959381b869 + size: 726309 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/24/10.yaml + original: lts-24.10 diff --git a/tablebot.cabal b/tablebot.cabal new file mode 100644 index 0000000..be18c7b --- /dev/null +++ b/tablebot.cabal @@ -0,0 +1,307 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.37.0. +-- +-- see: https://github.com/sol/hpack + +name: tablebot +version: 0.3.3 +description: Please see the README on GitHub at +homepage: https://github.com/WarwickTabletop/tablebot#readme +bug-reports: https://github.com/WarwickTabletop/tablebot/issues +author: Warwick Tabletop +maintainer: tagarople@gmail.com +copyright: 2021 Warwick Tabletop +license: MIT +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/WarwickTabletop/tablebot + +library + exposed-modules: + Tablebot + Tablebot.Handler + Tablebot.Internal.Administration + Tablebot.Internal.Alias + Tablebot.Internal.Cache + Tablebot.Internal.Embed + Tablebot.Internal.Handler.Command + Tablebot.Internal.Handler.Event + Tablebot.Internal.Permission + Tablebot.Internal.Plugins + Tablebot.Internal.Types + Tablebot.Plugins + Tablebot.Plugins.Administration + Tablebot.Plugins.Alias + Tablebot.Plugins.Basic + Tablebot.Plugins.Cats + Tablebot.Plugins.Dogs + Tablebot.Plugins.Flip + Tablebot.Plugins.Fox + Tablebot.Plugins.Netrunner + Tablebot.Plugins.Netrunner.Command.BanList + Tablebot.Plugins.Netrunner.Command.Custom + Tablebot.Plugins.Netrunner.Command.Find + Tablebot.Plugins.Netrunner.Command.Help + Tablebot.Plugins.Netrunner.Command.Rules + Tablebot.Plugins.Netrunner.Command.Search + Tablebot.Plugins.Netrunner.Plugin + Tablebot.Plugins.Netrunner.Type.BanList + Tablebot.Plugins.Netrunner.Type.Card + Tablebot.Plugins.Netrunner.Type.Cycle + Tablebot.Plugins.Netrunner.Type.Faction + Tablebot.Plugins.Netrunner.Type.NrApi + Tablebot.Plugins.Netrunner.Type.Pack + Tablebot.Plugins.Netrunner.Type.Type + Tablebot.Plugins.Netrunner.Utility.BanList + Tablebot.Plugins.Netrunner.Utility.Card + Tablebot.Plugins.Netrunner.Utility.Cycle + Tablebot.Plugins.Netrunner.Utility.Embed + Tablebot.Plugins.Netrunner.Utility.Faction + Tablebot.Plugins.Netrunner.Utility.Misc + Tablebot.Plugins.Netrunner.Utility.NrApi + Tablebot.Plugins.Netrunner.Utility.Pack + Tablebot.Plugins.Ping + Tablebot.Plugins.Quote + Tablebot.Plugins.Reminder + Tablebot.Plugins.Roll + Tablebot.Plugins.Roll.Dice + Tablebot.Plugins.Roll.Dice.DiceData + Tablebot.Plugins.Roll.Dice.DiceEval + Tablebot.Plugins.Roll.Dice.DiceFunctions + Tablebot.Plugins.Roll.Dice.DiceParsing + Tablebot.Plugins.Roll.Dice.DiceStats + Tablebot.Plugins.Roll.Dice.DiceStatsBase + Tablebot.Plugins.Roll.Plugin + Tablebot.Plugins.Say + Tablebot.Plugins.Shibe + Tablebot.Plugins.Suggest + Tablebot.Plugins.Welcome + Tablebot.Utility + Tablebot.Utility.Discord + Tablebot.Utility.Embed + Tablebot.Utility.Exception + Tablebot.Utility.Font + Tablebot.Utility.Help + Tablebot.Utility.Parser + Tablebot.Utility.Permission + Tablebot.Utility.Random + Tablebot.Utility.Search + Tablebot.Utility.SmartParser + Tablebot.Utility.SmartParser.Interactions + Tablebot.Utility.SmartParser.SmartParser + Tablebot.Utility.SmartParser.Types + Tablebot.Utility.Types + Tablebot.Utility.Utils + other-modules: + Paths_tablebot + hs-source-dirs: + src + default-extensions: + OverloadedStrings + LambdaCase + EmptyDataDecls + FlexibleContexts + GADTs + GeneralizedNewtypeDeriving + MultiParamTypeClasses + QuasiQuotes + TemplateHaskell + TypeFamilies + DerivingStrategies + StandaloneDeriving + UndecidableInstances + DataKinds + FlexibleInstances + DeriveGeneric + TypeApplications + MultiWayIf + TupleSections + ConstraintKinds + RecordWildCards + ScopedTypeVariables + TypeOperators + RankNTypes + BangPatterns + ghc-options: -Wall + build-depends: + Chart + , Chart-diagrams + , JuicyPixels + , SVGFonts + , aeson + , base >=4.7 && <5 + , bytestring + , containers + , data-default + , diagrams-core + , diagrams-lib + , diagrams-rasterific + , discord-haskell + , distribution + , duckling + , edit-distance + , emoji + , esqueleto + , exception-transformers + , extra + , filepath + , http-client + , http-conduit + , load-env + , megaparsec + , monad-logger + , mtl + , persistent + , persistent-sqlite + , persistent-template + , process + , random + , raw-strings-qq + , regex-pcre + , req + , resource-pool + , resourcet + , safe + , scientific + , split + , template-haskell + , text + , text-icu + , th-printf + , time + , timezone-olson + , transformers + , unliftio + , unordered-containers + , yaml + default-language: Haskell2010 + +executable tablebot-exe + main-is: Main.hs + other-modules: + Paths_tablebot + hs-source-dirs: + app + ghc-options: -threaded -rtsopts "-with-rtsopts=-Iw10 -N" + build-depends: + Chart + , Chart-diagrams + , JuicyPixels + , SVGFonts + , aeson + , base >=4.7 && <5 + , bytestring + , containers + , data-default + , diagrams-core + , diagrams-lib + , diagrams-rasterific + , discord-haskell + , distribution + , duckling + , edit-distance + , emoji + , esqueleto + , exception-transformers + , extra + , filepath + , http-client + , http-conduit + , load-env + , megaparsec + , monad-logger + , mtl + , persistent + , persistent-sqlite + , persistent-template + , process + , random + , raw-strings-qq + , regex-pcre + , req + , resource-pool + , resourcet + , safe + , scientific + , split + , tablebot + , template-haskell + , text + , text-icu + , th-printf + , time + , timezone-olson + , transformers + , unliftio + , unordered-containers + , yaml + default-language: Haskell2010 + +test-suite tablebot-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_tablebot + hs-source-dirs: + test + ghc-options: -threaded -rtsopts -with-rtsopts=-N + build-depends: + Chart + , Chart-diagrams + , JuicyPixels + , SVGFonts + , aeson + , base >=4.7 && <5 + , bytestring + , containers + , data-default + , diagrams-core + , diagrams-lib + , diagrams-rasterific + , discord-haskell + , distribution + , duckling + , edit-distance + , emoji + , esqueleto + , exception-transformers + , extra + , filepath + , http-client + , http-conduit + , load-env + , megaparsec + , monad-logger + , mtl + , persistent + , persistent-sqlite + , persistent-template + , process + , random + , raw-strings-qq + , regex-pcre + , req + , resource-pool + , resourcet + , safe + , scientific + , split + , tablebot + , template-haskell + , text + , text-icu + , th-printf + , time + , timezone-olson + , transformers + , unliftio + , unordered-containers + , yaml + default-language: Haskell2010 From 2393ce8230e4185d80a0c043a6f7d4f429cc92c5 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:18:19 +0100 Subject: [PATCH 34/53] import fixes and discord-haskell upstream updates some structures got more fields for localisation, the Num instance of DiscordId was removed. some other small fixes --- src/Tablebot.hs | 9 +-- src/Tablebot/Handler.hs | 2 +- src/Tablebot/Internal/Administration.hs | 3 +- src/Tablebot/Internal/Alias.hs | 6 +- src/Tablebot/Internal/Types.hs | 2 +- src/Tablebot/Plugins/Administration.hs | 2 +- src/Tablebot/Plugins/Quote.hs | 60 ++++++++++++------- src/Tablebot/Plugins/Reminder.hs | 2 +- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 3 +- .../Plugins/Roll/Dice/DiceStatsBase.hs | 2 +- src/Tablebot/Plugins/Roll/Plugin.hs | 3 +- src/Tablebot/Utility/Discord.hs | 12 +++- .../Utility/SmartParser/Interactions.hs | 10 ++-- src/Tablebot/Utility/Types.hs | 2 +- 14 files changed, 70 insertions(+), 48 deletions(-) diff --git a/src/Tablebot.hs b/src/Tablebot.hs index 09fe4a6..f534650 100644 --- a/src/Tablebot.hs +++ b/src/Tablebot.hs @@ -144,13 +144,8 @@ runTablebot vinfo dToken prefix dbpath plugins config = activityStatus = UpdateStatusOpts { updateStatusOptsSince = Nothing, - updateStatusOptsGame = - Just - ( def - { activityName = gamePlaying config prefix, - activityType = ActivityTypeGame - } - ), + updateStatusOptsActivities = + [mkActivity (gamePlaying config prefix) ActivityTypeGame], updateStatusOptsNewStatus = UpdateStatusOnline, updateStatusOptsAFK = False } diff --git a/src/Tablebot/Handler.hs b/src/Tablebot/Handler.hs index d484857..8e8a41e 100644 --- a/src/Tablebot/Handler.hs +++ b/src/Tablebot/Handler.hs @@ -127,7 +127,7 @@ submitApplicationCommands compiledAppComms cacheMVar = Nothing -> pure () Just serverIdStr -> do serverId <- readServerStr serverIdStr - aid <- partialApplicationID . cacheApplication <$> readCache + aid <- fullApplicationID . cacheApplication <$> readCache applicationCommands <- mapM ( \(CApplicationCommand cac action) -> do diff --git a/src/Tablebot/Internal/Administration.hs b/src/Tablebot/Internal/Administration.hs index 8c05139..dbaac6d 100644 --- a/src/Tablebot/Internal/Administration.hs +++ b/src/Tablebot/Internal/Administration.hs @@ -14,7 +14,8 @@ module Tablebot.Internal.Administration ) where -import Control.Monad.Cont (MonadIO, void, when) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad (void, when) import Data.List.Extra (isInfixOf, lower, trim) import Data.Text (Text, pack) import Database.Persist diff --git a/src/Tablebot/Internal/Alias.hs b/src/Tablebot/Internal/Alias.hs index 7782c70..76851fa 100644 --- a/src/Tablebot/Internal/Alias.hs +++ b/src/Tablebot/Internal/Alias.hs @@ -10,7 +10,7 @@ module Tablebot.Internal.Alias where import Control.Monad.Exception (MonadException (catch), SomeException) -import Data.Text +import qualified Data.Text as T import Database.Persist.Sqlite (BackendKey (SqlBackendKey)) import qualified Database.Persist.Sqlite as Sql import Database.Persist.TH @@ -24,8 +24,8 @@ share [mkPersist sqlSettings, mkMigrate "aliasMigration"] [persistLowerCase| Alias - alias Text - command Text + alias T.Text + command T.Text type AliasType UniqueAlias alias type deriving Show diff --git a/src/Tablebot/Internal/Types.hs b/src/Tablebot/Internal/Types.hs index 7a430e1..899401e 100644 --- a/src/Tablebot/Internal/Types.hs +++ b/src/Tablebot/Internal/Types.hs @@ -127,7 +127,7 @@ instance PersistField AliasType where toPersistValue AliasPublic = PersistInt64 (-1) fromPersistValue = \case PersistInt64 (-1) -> Right AliasPublic - PersistInt64 i -> Right $ AliasPrivate (fromIntegral i) + PersistInt64 i -> Right $ AliasPrivate (DiscordId (Snowflake (fromIntegral i))) _ -> Left "AliasType: fromPersistValue: Invalid value" instance PersistFieldSql AliasType where diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index 6de41e6..4bc36c9 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -13,7 +13,7 @@ module Tablebot.Plugins.Administration (administrationPlugin) where import Control.Concurrent.MVar (MVar, swapMVar) import Control.Monad (when) -import Control.Monad.Cont (liftIO) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Reader (ask) import Data.Text (Text, pack) import qualified Data.Text as T diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index 33d53b6..1809e8a 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -14,10 +14,11 @@ module Tablebot.Plugins.Quote (quotes) where import Control.Monad.IO.Class (liftIO) +import Control.Monad (join) import Data.Aeson import Data.Default (Default (def)) import Data.Functor ((<&>)) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Text (Text, append, pack, unpack) import Data.Time.Clock.System (SystemTime (systemSeconds), getSystemTime, systemToUTCTime) import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, (==.)) @@ -42,6 +43,8 @@ import Tablebot.Utility.Discord sendMessage, toMention, toMention', + idToWord, + wordToId, ) import Tablebot.Utility.Embed import Tablebot.Utility.Exception (BotException (GenericException, InteractionException), catchBot, throwBot) @@ -49,6 +52,7 @@ import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.Search import Tablebot.Utility.SmartParser import Text.RawString.QQ (r) +import Data.Word -- Our Quote table in the database. This is fairly standard for Persistent, -- however you should note the name of the migration made. @@ -59,8 +63,8 @@ Quote quote Text author Text submitter Text - msgId Int - cnlId Int + msgId Word64 + cnlId Word64 time UTCTime deriving Show |] @@ -233,7 +237,7 @@ addQ qu author m = fst <$> addQ' qu author (toMention $ messageAuthor m) (messag addQ' :: (Context m) => Text -> Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord (MessageDetails, Int64) addQ' qu author requestor sourceMsg sourceChannel m = do now <- liftIO $ systemToUTCTime <$> getSystemTime - let new = Quote qu author requestor (fromIntegral sourceMsg) (fromIntegral sourceChannel) now + let new = Quote qu author requestor (idToWord sourceMsg) (idToWord sourceChannel) now added <- insert new let res = pack $ show $ fromSqlKey added renderCustomQuoteMessage ("Quote added as #" `append` res) new (fromSqlKey added) Nothing m <&> (,fromSqlKey added) @@ -266,8 +270,8 @@ addMessageQuote submitter q' m = do (messageContent q') (toMention $ messageAuthor q') (toMention' submitter) - (fromIntegral $ messageId q') - (fromIntegral $ messageChannelId q') + (idToWord $ messageId q') + (idToWord $ messageChannelId q') now added <- insert new let res = pack $ show $ fromSqlKey added @@ -279,7 +283,7 @@ addMessageQuote submitter q' m = do -- @!quote edit n "quoted text" - author@, and then updates quote with id n in the -- database, to match the provided quote. editQ :: Int64 -> Text -> Text -> Message -> DatabaseDiscord () -editQ qId qu author m = editQ' qId (Just qu) (Just author) (toMention $ messageAuthor m) (fromIntegral $ messageId m) (fromIntegral $ messageChannelId m) m >>= sendCustomMessage m +editQ qId qu author m = editQ' qId (Just qu) (Just author) (toMention $ messageAuthor m) (messageId m) (messageChannelId m) m >>= sendCustomMessage m editQ' :: (Context m) => Int64 -> Maybe Text -> Maybe Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord MessageDetails editQ' qId qu author requestor mid cid m = @@ -290,7 +294,7 @@ editQ' qId qu author requestor mid cid m = case oQu of Just (Quote qu' author' _ _ _ _) -> do now <- liftIO $ systemToUTCTime <$> getSystemTime - let new = Quote (fromMaybe qu' qu) (fromMaybe author' author) requestor (fromIntegral mid) (fromIntegral cid) now + let new = Quote (fromMaybe qu' qu) (fromMaybe author' author) requestor (idToWord mid) (idToWord cid) now replace k new renderCustomQuoteMessage "Quote updated" new qId Nothing m Nothing -> return $ messageDetailsBasic "Couldn't update that quote!" @@ -330,13 +334,13 @@ renderCustomQuoteMessage t (Quote txt author submitter msgId cnlId dtm) qId mb m ) where getLink :: Maybe GuildId -> Maybe Text - getLink = fmap (\x -> getMessageLink x (fromIntegral cnlId) (fromIntegral msgId)) + getLink = fmap (\x -> getMessageLink x (wordToId cnlId) (wordToId msgId)) maybeAddFooter :: Maybe Text -> Text maybeAddFooter (Just l) = "\n[source](" <> l <> ") - added by " <> submitter maybeAddFooter Nothing = "" quoteApplicationCommand :: CreateApplicationCommand -quoteApplicationCommand = CreateApplicationCommandChatInput "quote" "store and retrieve quotes" (Just opts) Nothing True +quoteApplicationCommand = CreateApplicationCommandChatInput "quote" Nothing "store and retrieve quotes" Nothing (Just opts) Nothing (Just True) where opts = OptionsSubcommands $ @@ -350,33 +354,43 @@ quoteApplicationCommand = CreateApplicationCommandChatInput "quote" "store and r addQuoteAppComm = OptionSubcommand "add" + Nothing "add a new quote" - [ OptionValueString "quote" "what the actual quote is" True (Left False), - OptionValueString "author" "who authored this quote" True (Left False) + Nothing + [ OptionValueString "quote" Nothing "what the actual quote is" Nothing True (Left False) Nothing Nothing, + OptionValueString "author" Nothing "who authored this quote" Nothing True (Left False) Nothing Nothing ] showQuoteAppComm = OptionSubcommand "show" + Nothing "show a quote by number" - [ OptionValueInteger "id" "the quote's number" True (Left True) (Just 1) Nothing + Nothing + [ OptionValueInteger "id" Nothing "the quote's number" Nothing True (Left True) (Just 1) Nothing ] randomQuoteAppComm = OptionSubcommand "random" + Nothing "show a random quote" + Nothing [] authorQuoteAppComm = OptionSubcommand "author" + Nothing "show a random quote by an author" - [OptionValueString "author" "whose quotes do you want to see" True (Left False)] + Nothing + [OptionValueString "author" Nothing "whose quotes do you want to see" Nothing True (Left False) Nothing Nothing] editQuoteAppComm = OptionSubcommand "edit" + Nothing "edit a quote" - [ OptionValueInteger "quoteid" "the id of the quote to edit" True (Left False) Nothing Nothing, - OptionValueString "quote" "what the actual quote is" False (Left False), - OptionValueString "author" "who authored this quote" False (Left False) + Nothing + [ OptionValueInteger "quoteid" Nothing "the id of the quote to edit" Nothing True (Left False) Nothing Nothing, + OptionValueString "quote" Nothing "what the actual quote is" Nothing False (Left False) Nothing Nothing, + OptionValueString "author" Nothing "who authored this quote" Nothing False (Left False) Nothing Nothing ] quoteApplicationCommandRecv :: Interaction -> DatabaseDiscord () @@ -406,7 +420,7 @@ quoteApplicationCommandRecv ((getValue "quote" vals >>= stringFromOptionValue) >>= \q -> (getValue "author" vals >>= stringFromOptionValue) <&> (q,)) ( \(qt, author) -> do let requestor = toMention' $ contextUserId i - (msg, qid) <- addQ' qt author requestor 0 0 i + (msg, qid) <- addQ' qt author requestor (wordToId 0) (wordToId 0) i interactionResponseCustomMessage i msg -- to get the message to display as wanted, we have to do some trickery -- we have already sent off the message above with the broken message id @@ -418,7 +432,7 @@ quoteApplicationCommandRecv Left _ -> return () Right m -> do now <- liftIO $ systemToUTCTime <$> getSystemTime - let new = Quote qt author requestor (fromIntegral $ messageId m) (fromIntegral $ messageChannelId m) now + let new = Quote qt author requestor (idToWord $ messageId m) (idToWord $ messageChannelId m) now replace (toSqlKey qid) new newMsg <- renderCustomQuoteMessage (messageContent m) new qid Nothing i _ <- liftDiscord $ restCall $ R.EditOriginalInteractionResponse (interactionApplicationId i) (interactionToken i) (convertMessageFormatInteraction newMsg) @@ -434,13 +448,13 @@ quoteApplicationCommandRecv case (qt, author) of (Nothing, Nothing) -> interactionResponseCustomMessage i (makeEphermeral (messageDetailsBasic "No edits made to quote.")) _ -> do - msg <- editQ' qid qt author (toMention' $ contextUserId i) 0 0 i + msg <- editQ' qid qt author (toMention' $ contextUserId i) (wordToId 0) (wordToId 0) i interactionResponseCustomMessage i msg v <- liftDiscord $ restCall $ R.GetOriginalInteractionResponse (interactionApplicationId i) (interactionToken i) case v of Left _ -> return () Right m -> do - msg' <- editQ' qid qt author (toMention' $ contextUserId i) (fromIntegral $ messageId m) (fromIntegral $ messageChannelId m) i + msg' <- editQ' qid qt author (toMention' $ contextUserId i) (messageId m) (messageChannelId m) i _ <- liftDiscord $ restCall $ R.EditOriginalInteractionResponse (interactionApplicationId i) (interactionToken i) (convertMessageFormatInteraction msg') return () ) @@ -466,12 +480,12 @@ quoteApplicationCommandRecv handleNothing (getValue "id" vals) ( \case - OptionDataValueInteger _ (Right showid') -> interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger [Choice (pack $ show showid') showid'] + OptionDataValueInteger _ (Right showid') -> interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger [Choice (pack $ show showid') Nothing showid'] OptionDataValueInteger _ (Left showid') -> do allQ <- allQuotes () let allQ' = (\qe -> (show (fromSqlKey $ entityKey qe), (fromSqlKey $ entityKey qe, (\(Quote q _ _ _ _ _) -> q) (entityVal qe)))) <$> allQ options = take 25 $ closestPairsWithCosts (def {deletion = 100, substitution = 100, transposition = 5}) allQ' (unpack showid') - interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger ((\(qids, (qid, _)) -> Choice (pack qids) (toInteger qid)) <$> options) + interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger ((\(qids, (qid, _)) -> Choice (pack qids) Nothing (toInteger qid)) <$> options) _ -> return () ) _ -> return () diff --git a/src/Tablebot/Plugins/Reminder.hs b/src/Tablebot/Plugins/Reminder.hs index 528b8df..e7a9c4d 100644 --- a/src/Tablebot/Plugins/Reminder.hs +++ b/src/Tablebot/Plugins/Reminder.hs @@ -134,7 +134,7 @@ reminderCron = do res <- getMessage (DiscordId $ Snowflake cid) (DiscordId $ Snowflake mid) case res of Left _ -> do - sendChannelMessage (fromIntegral cid) (pack $ "Reminder to <@" ++ show uid ++ ">! " ++ content) + sendChannelMessage (DiscordId (Snowflake cid)) (pack $ "Reminder to <@" ++ show uid ++ ">! " ++ content) delete (entityKey re) Right mess -> do sendCustomReplyMessage mess (DiscordId $ Snowflake mid) True $ diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index 1e7faea..370a873 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -11,7 +11,8 @@ module Tablebot.Plugins.Roll.Dice.DiceEval (ParseShow (parseShow), evalProgram, evalList, evalInteger, evaluationException, propagateException, maximumRNG, maximumListLength) where import Control.Monad.Exception (MonadException) -import Control.Monad.State (MonadIO (liftIO), StateT, evalStateT, gets, modify, when) +import Control.Monad.State (MonadIO (liftIO), StateT, evalStateT, gets, modify) +import Control.Monad (when) import Data.List (foldl', genericDrop, genericReplicate, genericTake, sortBy) import Data.List.NonEmpty as NE (NonEmpty ((:|)), head, tail, (<|)) import Data.Map (Map, empty) diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs index c8d031e..bfbda8f 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs @@ -68,7 +68,7 @@ distributionRenderable d = toRenderable $ do layout_y_axis . laxis_override .= \ad@AxisData {_axis_labels = axisLabels} -> ad {_axis_labels = (second (\s -> if '.' `elem` s then s else s ++ ".0") <$>) <$> axisLabels} layout_all_font_styles .= defFontStyle pb <- (bars @Integer @Double) (barNames d) pts - let pb' = pb {_plot_bars_spacing = BarsFixGap 10 5} + let pb' = set plot_bars_spacing (BarsFixGap 10 5) pb plot $ return $ plotBars pb' where removeNullMap m diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 54b023d..cef900f 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -9,7 +9,8 @@ -- A command that outputs the result of rolling the input dice. module Tablebot.Plugins.Roll.Plugin (rollPlugin) where -import Control.Monad.Writer (MonadIO (liftIO), void) +import Control.Monad.IO.Class (MonadIO (liftIO)) +import Control.Monad (void) import Data.ByteString.Lazy (toStrict) import Data.Default (Default (def)) import Data.Distribution (isValid) diff --git a/src/Tablebot/Utility/Discord.hs b/src/Tablebot/Utility/Discord.hs index 883c899..43b0a8e 100644 --- a/src/Tablebot/Utility/Discord.hs +++ b/src/Tablebot/Utility/Discord.hs @@ -48,10 +48,12 @@ module Tablebot.Utility.Discord interactionResponseCustomMessage, interactionResponseComponentsUpdateMessage, interactionResponseAutocomplete, + idToWord, + wordToId ) where -import Control.Monad.Cont (liftIO) +import Control.Monad.IO.Class (liftIO) import Control.Monad.Exception (MonadException (throw)) import Data.Char (isDigit) import Data.Default (Default (def)) @@ -73,6 +75,7 @@ import Tablebot.Internal.Cache (fillEmojiCache, lookupEmojiCache) import Tablebot.Internal.Embed (Embeddable (..)) import Tablebot.Utility (EnvDatabaseDiscord, MessageDetails, convertMessageFormatBasic, convertMessageFormatInteraction, liftDiscord, messageDetailsBasic) import Tablebot.Utility.Exception (BotException (..)) +import Data.Coerce ( coerce ) -- | @sendMessage@ sends the input message @t@ in the same channel as message -- @m@. @@ -449,3 +452,10 @@ interactionResponseAutocomplete i ac = do case res of Left _ -> throw $ InteractionException "Failed to respond to interaction with autocomplete response." Right _ -> return () + +-- | Not guaranteed to be a valid ID! +wordToId :: Word64 -> DiscordId a +wordToId = coerce + +idToWord :: DiscordId a -> Word64 +idToWord = coerce diff --git a/src/Tablebot/Utility/SmartParser/Interactions.hs b/src/Tablebot/Utility/SmartParser/Interactions.hs index 7925ca5..078e973 100644 --- a/src/Tablebot/Utility/SmartParser/Interactions.hs +++ b/src/Tablebot/Utility/SmartParser/Interactions.hs @@ -78,21 +78,21 @@ class MakeAppCommArg commandty where -- | Create a labelled text argument. By default it is required and does not -- have autocompeletion. instance (KnownSymbol name, KnownSymbol desc) => MakeAppCommArg (Labelled name desc Text) where - makeAppCommArg l = OptionValueString n d True (Left False) + makeAppCommArg l = OptionValueString n Nothing d Nothing True (Left False) Nothing Nothing where (n, d) = getLabelValues l -- | Create a labelled integer argument. By default it is required and does not -- have autocompeletion, and does not have bounds. instance (KnownSymbol name, KnownSymbol desc) => MakeAppCommArg (Labelled name desc Integer) where - makeAppCommArg l = OptionValueInteger n d True (Left False) Nothing Nothing + makeAppCommArg l = OptionValueInteger n Nothing d Nothing True (Left False) Nothing Nothing where (n, d) = getLabelValues l -- | Create a labelled scientific argument. By default it is required and does not -- have autocompeletion, and does not have bounds. instance (KnownSymbol name, KnownSymbol desc) => MakeAppCommArg (Labelled name desc Scientific) where - makeAppCommArg l = OptionValueNumber n d True (Left False) Nothing Nothing + makeAppCommArg l = OptionValueNumber n Nothing d Nothing True (Left False) Nothing Nothing where (n, d) = getLabelValues l @@ -274,8 +274,8 @@ onlyAllowRequestor' msg f = do ) <* eof where - prefunc :: UserId -> SenderUserId -> Interaction -> DatabaseDiscord (Maybe MessageDetails) - prefunc uid (SenderUserId u) i = + prefunc :: Snowflake -> SenderUserId -> Interaction -> DatabaseDiscord (Maybe MessageDetails) + prefunc uid (SenderUserId (DiscordId u)) i = if uid == u then return Nothing else diff --git a/src/Tablebot/Utility/Types.hs b/src/Tablebot/Utility/Types.hs index 097dfe8..e916a9a 100644 --- a/src/Tablebot/Utility/Types.hs +++ b/src/Tablebot/Utility/Types.hs @@ -359,7 +359,7 @@ instance Context Message where instance Context Interaction where -- this is safe to do because we are guaranteed to get either a user or a member - contextUserId i = maybe 0 userId (either memberUser Just mor) + contextUserId i = maybe (DiscordId (Snowflake 0)) userId (either memberUser Just mor) where (MemberOrUser mor) = interactionUser i contextGuildId i = return $ interactionGuildId i From 35e325c414293516ef27c8f1af9b5fb65c0cafb7 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:19:20 +0100 Subject: [PATCH 35/53] adjust the integral parser to have a concrete type this massively helps type inference --- src/Tablebot/Utility/SmartParser/SmartParser.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Tablebot/Utility/SmartParser/SmartParser.hs b/src/Tablebot/Utility/SmartParser/SmartParser.hs index a623854..1b6e534 100644 --- a/src/Tablebot/Utility/SmartParser/SmartParser.hs +++ b/src/Tablebot/Utility/SmartParser/SmartParser.hs @@ -189,10 +189,11 @@ instance (KnownSymbol s) => CanParse (Exactly s) where instance (KnownSymbol err, CanParse x) => CanParse (WithError err x) where pars = (WErr <$> try (pars @x)) symbolVal (Proxy :: Proxy err) +newtype IntegralData a = MkIntegralData a + -- | Parsing implementation for all integral types --- Overlappable due to the really flexible head state -instance {-# OVERLAPPABLE #-} (Integral a, Read a) => CanParse a where - pars = integer +instance (Integral a, Read a) => CanParse (IntegralData a) where + pars = MkIntegralData <$> integer instance CanParse Double where pars = double From 2f1f49653af37c357cba1ceec8e89b57ae474c64 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:20:55 +0100 Subject: [PATCH 36/53] use the new IntegralData --- src/Tablebot/Plugins/Quote.hs | 16 ++++++++-------- src/Tablebot/Plugins/Reminder.hs | 6 +++--- 2 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index 1809e8a..eb040eb 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -93,11 +93,11 @@ quoteCommand = quoteComm :: WithError "Unknown quote functionality." - (Either () (Either Int64 (RestOfInput Text))) -> + (Either () (Either (IntegralData Int64) (RestOfInput Text))) -> Message -> DatabaseDiscord () quoteComm (WErr (Left ())) m = randomQ m >>= sendCustomMessage m - quoteComm (WErr (Right (Left t))) m = showQ t m >>= sendCustomMessage m + quoteComm (WErr (Right (Left (MkIntegralData t)))) m = showQ t m >>= sendCustomMessage m quoteComm (WErr (Right (Right (ROI t)))) m = authorQ t m >>= sendCustomMessage m addQuote :: Command @@ -115,10 +115,10 @@ editQuote = Command "edit" (parseComm editComm) [] editComm :: WithError "Edit format incorrect!\nFormat is: .quote edit quoteId \"new quote\" - author" - (Int64, Quoted Text, Exactly "-", RestOfInput Text) -> + ((IntegralData Int64), Quoted Text, Exactly "-", RestOfInput Text) -> Message -> DatabaseDiscord () - editComm (WErr (qId, Qu qu, _, ROI author)) = editQ qId qu author + editComm (WErr (MkIntegralData qId, Qu qu, _, ROI author)) = editQ qId qu author thisQuote :: Command thisQuote = Command "this" (parseComm thisComm) [] @@ -154,19 +154,19 @@ showQuote :: Command showQuote = Command "show" (parseComm showComm) [] where showComm :: - WithError "Quote format incorrect!\nExpected quote number to show, e.g. .quote show 420" Int64 -> + WithError "Quote format incorrect!\nExpected quote number to show, e.g. .quote show 420" (IntegralData Int64) -> Message -> DatabaseDiscord () - showComm (WErr qId) m = showQ qId m >>= sendCustomMessage m + showComm (WErr (MkIntegralData qId)) m = showQ qId m >>= sendCustomMessage m deleteQuote :: Command deleteQuote = Command "delete" (parseComm deleteComm) [] where deleteComm :: - WithError "Quote format incorrect!\nExpected quote number to delete, e.g. .quote delete 420" Int64 -> + WithError "Quote format incorrect!\nExpected quote number to delete, e.g. .quote delete 420" (IntegralData Int64) -> Message -> DatabaseDiscord () - deleteComm (WErr qId) = deleteQ qId + deleteComm (WErr (MkIntegralData qId)) = deleteQ qId randomQuote :: Command randomQuote = Command "random" (parseComm randomComm) [] diff --git a/src/Tablebot/Plugins/Reminder.hs b/src/Tablebot/Plugins/Reminder.hs index e7a9c4d..d158e85 100644 --- a/src/Tablebot/Plugins/Reminder.hs +++ b/src/Tablebot/Plugins/Reminder.hs @@ -31,7 +31,7 @@ import Tablebot.Utility import Tablebot.Utility.Database import Tablebot.Utility.Discord (getMessage, sendChannelMessage, sendCustomReplyMessage, sendMessage, toTimestamp) import Tablebot.Utility.Permission (requirePermission) -import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), WithError (..)) +import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), WithError (..), IntegralData(..)) import Text.RawString.QQ (r) -- Our Reminder table in the database. This is fairly standard for Persistent, @@ -98,8 +98,8 @@ addReminder time content m = do sendMessage m ("Reminder " <> res <> " set for " <> toTimestamp time <> " with message `" <> pack content <> "`") -- @deleteReminder@ takes a reminder Id and deletes it from the list of awating reminders. -deleteReminder :: WithError "Missing required argument" (Int) -> Message -> DatabaseDiscord () -deleteReminder (WErr rid) m = requirePermission Any m $ do +deleteReminder :: WithError "Missing required argument" (IntegralData Int) -> Message -> DatabaseDiscord () +deleteReminder (WErr (MkIntegralData rid)) m = requirePermission Any m $ do delete k sendMessage m ("Reminder " <> pack (show rid) <> " deleted.") where From d7e163e1bd2853372465d577b19a075ef9bfbdc5 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:21:59 +0100 Subject: [PATCH 37/53] remove Tablebot.Utility.Database in favour of lifting sql functions when we need This is what we were doing anyway effectively; let's not waste thinking overhead by keeping this around. --- src/Tablebot/Internal/Alias.hs | 5 +- src/Tablebot/Plugins/Administration.hs | 12 +-- src/Tablebot/Plugins/Alias.hs | 5 +- src/Tablebot/Plugins/Quote.hs | 46 +++++----- src/Tablebot/Plugins/Reminder.hs | 13 ++- src/Tablebot/Utility/Database.hs | 121 ------------------------- 6 files changed, 39 insertions(+), 163 deletions(-) delete mode 100644 src/Tablebot/Utility/Database.hs diff --git a/src/Tablebot/Internal/Alias.hs b/src/Tablebot/Internal/Alias.hs index 76851fa..f16a18f 100644 --- a/src/Tablebot/Internal/Alias.hs +++ b/src/Tablebot/Internal/Alias.hs @@ -17,8 +17,7 @@ import Database.Persist.TH import Discord.Types import Tablebot.Internal.Administration (currentBlacklist) import Tablebot.Internal.Types -import Tablebot.Utility.Database (liftSql, selectList) -import Tablebot.Utility.Types (EnvDatabaseDiscord) +import Tablebot.Utility.Types (EnvDatabaseDiscord, liftSql) share [mkPersist sqlSettings, mkMigrate "aliasMigration"] @@ -38,5 +37,5 @@ getAliases uid = do if "alias" `elem` blacklist then return Nothing else - (Just . fmap Sql.entityVal <$> selectList [AliasType Sql.<-. [AliasPublic, AliasPrivate uid]] []) + liftSql (Just . fmap Sql.entityVal <$> Sql.selectList [AliasType Sql.<-. [AliasPublic, AliasPrivate uid]] []) `catch` (\(_ :: SomeException) -> return Nothing) diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index 4bc36c9..33cd94d 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -26,11 +26,11 @@ import Tablebot.Internal.Administration import Tablebot.Internal.Cache (getVersionInfo) import Tablebot.Internal.Types (CompiledPlugin (compiledName)) import Tablebot.Utility -import Tablebot.Utility.Database import Tablebot.Utility.Discord (sendMessage) import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.SmartParser import Text.RawString.QQ +import qualified Database.Persist.Sqlite as Sql -- | @SS@ denotes the type returned by the command setup. Here its unused. type SS = [Text] @@ -60,19 +60,19 @@ addBlacklist pLabel m = requirePermission Superuser m $ do -- It's not an error to add an unknown plugin (so that you can pre-disable a plugin you know you're about to add), -- but emmit a warning so people know if it wasn't deliberate when (pack pLabel `notElem` known) $ sendMessage m "Warning, unknown plugin" - extant <- exists [PluginBlacklistLabel ==. pLabel] + extant <- liftSql $ Sql.exists [PluginBlacklistLabel ==. pLabel] if not extant then do - _ <- insert $ PluginBlacklist pLabel + _ <- liftSql $ Sql.insert $ PluginBlacklist pLabel sendMessage m "Plugin added to blacklist. Please reload for it to take effect" else sendMessage m "Plugin already in blacklist" removeBlacklist :: String -> Message -> EnvDatabaseDiscord SS () removeBlacklist pLabel m = requirePermission Superuser m $ do - extant <- selectKeysList [PluginBlacklistLabel ==. pLabel] [] + extant <- liftSql $ Sql.selectKeysList [PluginBlacklistLabel ==. pLabel] [] if not $ null extant then do - _ <- delete (head extant) + _ <- liftSql $ Sql.delete (head extant) sendMessage m "Plugin removed from blacklist. Please reload for it to take effect" else sendMessage m "Plugin not in blacklist" @@ -80,7 +80,7 @@ removeBlacklist pLabel m = requirePermission Superuser m $ do -- along with their current status. listBlacklist :: Message -> EnvDatabaseDiscord SS () listBlacklist m = requirePermission Superuser m $ do - bl <- selectList allBlacklisted [] + bl <- liftSql $ Sql.selectList allBlacklisted [] pl <- ask sendMessage m (format pl (blacklisted bl)) where diff --git a/src/Tablebot/Plugins/Alias.hs b/src/Tablebot/Plugins/Alias.hs index c7cef93..88ef25f 100644 --- a/src/Tablebot/Plugins/Alias.hs +++ b/src/Tablebot/Plugins/Alias.hs @@ -18,7 +18,6 @@ import Discord.Types import Tablebot.Internal.Alias import Tablebot.Internal.Types (AliasType (..)) import Tablebot.Utility -import Tablebot.Utility.Database (deleteBy, exists) import Tablebot.Utility.Discord (sendMessage) import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (..), WithError (..)) @@ -157,9 +156,9 @@ aliasDeleteCommand = aliasDelete :: Text -> AliasType -> Message -> DatabaseDiscord () aliasDelete a at m = do let toDelete = UniqueAlias a at - itemExists <- exists [AliasAlias Sql.==. a, AliasType Sql.==. at] + itemExists <- liftSql $ Sql.exists [AliasAlias Sql.==. a, AliasType Sql.==. at] if itemExists - then deleteBy toDelete >> sendMessage m ("Deleted alias `" <> a <> "`") + then liftSql (Sql.deleteBy toDelete) >> sendMessage m ("Deleted alias `" <> a <> "`") else sendMessage m ("No such alias `" <> a <> "`") aliasDeleteHelp :: HelpPage diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index eb040eb..24ccd05 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -21,7 +21,7 @@ import Data.Functor ((<&>)) import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Text (Text, append, pack, unpack) import Data.Time.Clock.System (SystemTime (systemSeconds), getSystemTime, systemToUTCTime) -import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, (==.)) +import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, (==.), toSqlKey, fromSqlKey) import Database.Persist.TH import Discord (restCall) import Discord.Interactions @@ -31,7 +31,6 @@ import GHC.Generics (Generic) import GHC.Int (Int64) import System.Random (randomRIO) import Tablebot.Utility -import Tablebot.Utility.Database import Tablebot.Utility.Discord ( getMessage, getMessageLink, @@ -52,6 +51,7 @@ import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.Search import Tablebot.Utility.SmartParser import Text.RawString.QQ (r) +import qualified Database.Persist.Sqlite as Sql import Data.Word -- Our Quote table in the database. This is fairly standard for Persistent, @@ -178,7 +178,7 @@ randomQuote = Command "random" (parseComm randomComm) [] -- that quote up in the database and responds with that quote. showQ :: (Context m) => Int64 -> m -> DatabaseDiscord MessageDetails showQ qId m = do - qu <- get $ toSqlKey qId + qu <- liftSql $ Sql.get $ toSqlKey qId case qu of Just q -> renderQuoteMessage q qId Nothing m Nothing -> return $ messageDetailsBasic "Couldn't get that quote!" @@ -217,14 +217,14 @@ filteredRandomQuote quoteFilter errorMessage mb m = catchBot (filteredRandomQuot -- goes wrong. filteredRandomQuote' :: (Context m) => [Filter Quote] -> Text -> Maybe Button -> m -> DatabaseDiscord MessageDetails filteredRandomQuote' quoteFilter errorMessage mb m = do - num <- count quoteFilter + num <- liftSql $ Sql.count quoteFilter if num == 0 -- we can't find any quotes meeting the filter then throwBot (GenericException "quote exception" (unpack errorMessage)) else do rindex <- liftIO $ randomRIO (0, num - 1) - key <- selectKeysList quoteFilter [OffsetBy rindex, LimitTo 1] - qu <- get $ head key - case qu of + key <- liftSql $ Sql.selectKeysList quoteFilter [OffsetBy rindex, LimitTo 1] + qu <- traverse (liftSql . Sql.get) $ listToMaybe key + case join qu of Just q -> renderQuoteMessage q (fromSqlKey $ head key) mb m Nothing -> throwBot (GenericException "quote exception" (unpack errorMessage)) @@ -238,7 +238,7 @@ addQ' :: (Context m) => Text -> Text -> Text -> MessageId -> ChannelId -> m -> D addQ' qu author requestor sourceMsg sourceChannel m = do now <- liftIO $ systemToUTCTime <$> getSystemTime let new = Quote qu author requestor (idToWord sourceMsg) (idToWord sourceChannel) now - added <- insert new + added <- liftSql $ Sql.insert new let res = pack $ show $ fromSqlKey added renderCustomQuoteMessage ("Quote added as #" `append` res) new (fromSqlKey added) Nothing m <&> (,fromSqlKey added) @@ -259,7 +259,7 @@ thisQ m = do -- | @addMessageQuote@, adds a message as a quote to the database, checking that it passes the relevant tests addMessageQuote :: (Context m) => UserId -> Message -> m -> DatabaseDiscord MessageDetails addMessageQuote submitter q' m = do - num <- count [QuoteMsgId ==. fromIntegral (messageId q')] + num <- liftSql $ Sql.count [QuoteMsgId ==. idToWord (messageId q')] if num == 0 then if not $ userIsBot (messageAuthor q') @@ -273,7 +273,7 @@ addMessageQuote submitter q' m = do (idToWord $ messageId q') (idToWord $ messageChannelId q') now - added <- insert new + added <- liftSql $ Sql.insert new let res = pack $ show $ fromSqlKey added renderCustomQuoteMessage ("Quote added as #" `append` res) new (fromSqlKey added) Nothing m else return $ makeEphermeral (messageDetailsBasic "Can't quote a bot") @@ -288,14 +288,14 @@ editQ qId qu author m = editQ' qId (Just qu) (Just author) (toMention $ messageA editQ' :: (Context m) => Int64 -> Maybe Text -> Maybe Text -> Text -> MessageId -> ChannelId -> m -> DatabaseDiscord MessageDetails editQ' qId qu author requestor mid cid m = requirePermission Any m $ - let k = toSqlKey qId + let k = Sql.toSqlKey qId in do - (oQu :: Maybe Quote) <- get k + (oQu :: Maybe Quote) <- liftSql $ Sql.get k case oQu of Just (Quote qu' author' _ _ _ _) -> do now <- liftIO $ systemToUTCTime <$> getSystemTime let new = Quote (fromMaybe qu' qu) (fromMaybe author' author) requestor (idToWord mid) (idToWord cid) now - replace k new + liftSql $ Sql.replace k new renderCustomQuoteMessage "Quote updated" new qId Nothing m Nothing -> return $ messageDetailsBasic "Couldn't update that quote!" @@ -304,12 +304,12 @@ editQ' qId qu author requestor mid cid m = deleteQ :: Int64 -> Message -> DatabaseDiscord () deleteQ qId m = requirePermission Any m $ - let k = toSqlKey qId + let k = Sql.toSqlKey qId in do - qu <- get k + qu <- liftSql $ Sql.get k case qu of Just Quote {} -> do - delete k + liftSql $ Sql.delete k sendMessage m "Quote deleted" Nothing -> sendMessage m "Couldn't delete that quote!" @@ -433,7 +433,7 @@ quoteApplicationCommandRecv Right m -> do now <- liftIO $ systemToUTCTime <$> getSystemTime let new = Quote qt author requestor (idToWord $ messageId m) (idToWord $ messageChannelId m) now - replace (toSqlKey qid) new + liftSql $ Sql.replace (toSqlKey qid) new newMsg <- renderCustomQuoteMessage (messageContent m) new qid Nothing i _ <- liftDiscord $ restCall $ R.EditOriginalInteractionResponse (interactionApplicationId i) (interactionToken i) (convertMessageFormatInteraction newMsg) return () @@ -482,7 +482,7 @@ quoteApplicationCommandRecv ( \case OptionDataValueInteger _ (Right showid') -> interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger [Choice (pack $ show showid') Nothing showid'] OptionDataValueInteger _ (Left showid') -> do - allQ <- allQuotes () + allQ <- allQuotes let allQ' = (\qe -> (show (fromSqlKey $ entityKey qe), (fromSqlKey $ entityKey qe, (\(Quote q _ _ _ _ _) -> q) (entityVal qe)))) <$> allQ options = take 25 $ closestPairsWithCosts (def {deletion = 100, substitution = 100, transposition = 5}) allQ' (unpack showid') interactionResponseAutocomplete i $ InteractionResponseAutocompleteInteger ((\(qids, (qid, _)) -> Choice (pack qids) Nothing (toInteger qid)) <$> options) @@ -607,8 +607,8 @@ instance FromJSON Quote instance ToJSON Quote -- | Get all the quotes in the database. -allQuotes :: () -> DatabaseDiscord [Entity Quote] -allQuotes _ = selectList [] [] +allQuotes :: DatabaseDiscord [Entity Quote] +allQuotes = liftSql $ Sql.selectList [] [] -- | Export all the quotes in the database to either a default quotes file or to a given -- file name that is quoted in the command. Superuser only. @@ -619,7 +619,7 @@ exportQ :: Maybe (Quoted FilePath) -> Message -> DatabaseDiscord () exportQ qfp m = requirePermission Superuser m $ do let defFileName = getSystemTime >>= \now -> return $ "quotes_" <> show (systemSeconds now) <> ".json" (Qu fp) <- liftIO $ maybe (Qu <$> defFileName) return qfp - aq <- fmap entityVal <$> allQuotes () + aq <- fmap entityVal <$> allQuotes _ <- liftIO $ encodeFile fp aq sendMessage m ("Succesfully exported all " <> (pack . show . length) aq <> " quotes to `" <> pack fp <> "`") @@ -630,7 +630,7 @@ importQuotes = Command "import" (parseComm importQ) [] importQ :: Quoted FilePath -> Message -> DatabaseDiscord () importQ (Qu fp) m = requirePermission Superuser m $ do mqs <- liftIO $ decodeFileStrict fp - qs <- maybe (throwBot $ GenericException "error getting file" "there was an error obtaining or decoding the quotes json") (insertMany @Quote) mqs + qs :: [Sql.Key Quote] <- maybe (throwBot $ GenericException "error getting file" "there was an error obtaining or decoding the quotes json") (liftSql . Sql.insertMany) mqs sendMessage m ("Succesfully imported " <> (pack . show . length) qs <> " quotes") -- | Clear all the quotes from the database. Superuser only. @@ -640,6 +640,6 @@ clearQuotes = Command "clear" (parseComm clearQ) [] clearQ :: Maybe (Quoted Text) -> Message -> DatabaseDiscord () clearQ (Just (Qu "clear the quotes")) m = requirePermission Superuser m $ do exportQ Nothing m - i <- deleteWhereCount @Quote [] + i <- liftSql $ Sql.deleteWhereCount @Quote [] sendMessage m ("Cleared " <> pack (show i) <> " quotes from the database.") clearQ _ m = sendMessage m "To _really do this_, call this command like so: `quote clear \"clear the quotes\"`" diff --git a/src/Tablebot/Plugins/Reminder.hs b/src/Tablebot/Plugins/Reminder.hs index d158e85..bb33584 100644 --- a/src/Tablebot/Plugins/Reminder.hs +++ b/src/Tablebot/Plugins/Reminder.hs @@ -21,14 +21,14 @@ import Data.Time.Clock.System (getSystemTime, systemToUTCTime) import Data.Time.LocalTime (ZonedTime, zonedTimeToUTC) import Data.Time.LocalTime.TimeZone.Olson.Parse (getTimeZoneSeriesFromOlsonFile) import Data.Word (Word64) -import Database.Esqueleto hiding (delete, insert) +import Database.Esqueleto.Legacy +import qualified Database.Persist.Sqlite as Sql import Database.Persist.TH import Discord.Types import Duckling.Core (Dimension (Time), Entity (value), Lang (EN), Region (GB), ResolvedVal (RVal), Seal (Seal), currentReftime, makeLocale, parse) import Duckling.Resolve (Context (..), DucklingTime, Options (..)) import Duckling.Time.Types (InstantValue (InstantValue), SingleTimeValue (SimpleValue), TimeValue (TimeValue)) import Tablebot.Utility -import Tablebot.Utility.Database import Tablebot.Utility.Discord (getMessage, sendChannelMessage, sendCustomReplyMessage, sendMessage, toTimestamp) import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), WithError (..), IntegralData(..)) @@ -93,14 +93,14 @@ addReminder time content m = do let (Snowflake cid) = unId $ messageChannelId m (Snowflake mid) = unId $ messageId m (Snowflake uid) = unId $ userId $ messageAuthor m - added <- insert $ Reminder cid mid uid time content + added <- liftSql $ Sql.insert $ Reminder cid mid uid time content let res = pack $ show $ fromSqlKey added sendMessage m ("Reminder " <> res <> " set for " <> toTimestamp time <> " with message `" <> pack content <> "`") -- @deleteReminder@ takes a reminder Id and deletes it from the list of awating reminders. deleteReminder :: WithError "Missing required argument" (IntegralData Int) -> Message -> DatabaseDiscord () deleteReminder (WErr (MkIntegralData rid)) m = requirePermission Any m $ do - delete k + liftSql $ Sql.delete k sendMessage m ("Reminder " <> pack (show rid) <> " deleted.") where k :: Key Reminder @@ -130,17 +130,16 @@ reminderCron = do forM_ entitydue $ \re -> let (Reminder cid mid uid _time content) = entityVal re in do - liftIO . print $ entityVal re res <- getMessage (DiscordId $ Snowflake cid) (DiscordId $ Snowflake mid) case res of Left _ -> do sendChannelMessage (DiscordId (Snowflake cid)) (pack $ "Reminder to <@" ++ show uid ++ ">! " ++ content) - delete (entityKey re) + liftSql $ Sql.delete (entityKey re) Right mess -> do sendCustomReplyMessage mess (DiscordId $ Snowflake mid) True $ pack $ "Reminder to <@" ++ show uid ++ ">! " ++ content - delete (entityKey re) + liftSql $ Sql.delete (entityKey re) reminderHelp :: HelpPage reminderHelp = diff --git a/src/Tablebot/Utility/Database.hs b/src/Tablebot/Utility/Database.hs deleted file mode 100644 index 2c3c5b3..0000000 --- a/src/Tablebot/Utility/Database.hs +++ /dev/null @@ -1,121 +0,0 @@ --- | --- Module : Tablebot.Utility.Database --- Description : Wrappers to database functionality to match our main monad. --- License : MIT --- Maintainer : tagarople@gmail.com --- Stability : experimental --- Portability : POSIX --- --- Wrappers to database functionality to match our main monad. -module Tablebot.Utility.Database - ( module Tablebot.Utility.Database, - Sql.fromSqlKey, - Sql.toSqlKey, - liftSql, - ) -where - -import Data.Int (Int64) -import Data.Map (Map) -import Data.Text (Text) -import qualified Database.Persist.Sqlite as Sql -import Tablebot.Utility (EnvDatabaseDiscord, liftSql) - -insert :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> EnvDatabaseDiscord d (Sql.Key record) -insert r = liftSql $ Sql.insert r - -insert_ :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> EnvDatabaseDiscord d () -insert_ r = liftSql $ Sql.insert_ r - -insertMany :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [record] -> EnvDatabaseDiscord d [Sql.Key record] -insertMany r = liftSql $ Sql.insertMany r - -insertMany_ :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [record] -> EnvDatabaseDiscord d () -insertMany_ r = liftSql $ Sql.insertMany_ r - -insertEntityMany :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Entity record] -> EnvDatabaseDiscord d () -insertEntityMany r = liftSql $ Sql.insertEntityMany r - -insertEntity :: (Sql.PersistEntity e, Sql.PersistEntityBackend e ~ Sql.SqlBackend) => e -> EnvDatabaseDiscord d (Sql.Entity e) -insertEntity r = liftSql $ Sql.insertEntity r - -insertEntityUnique :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> EnvDatabaseDiscord d (Maybe (Sql.Entity record)) -insertEntityUnique r = liftSql $ Sql.insertUniqueEntity r - -insertUnique :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> EnvDatabaseDiscord d (Maybe (Sql.Key record)) -insertUnique r = liftSql $ Sql.insertUnique r - -delete :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> EnvDatabaseDiscord d () -delete r = liftSql $ Sql.delete r - -deleteBy :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Unique record -> EnvDatabaseDiscord d () -deleteBy r = liftSql $ Sql.deleteBy r - -deleteCascade :: (Sql.DeleteCascade record Sql.SqlBackend) => Sql.Key record -> EnvDatabaseDiscord d () -deleteCascade r = liftSql $ Sql.deleteCascade r - -deleteCascadeWhere :: (Sql.DeleteCascade record Sql.SqlBackend) => [Sql.Filter record] -> EnvDatabaseDiscord d () -deleteCascadeWhere r = liftSql $ Sql.deleteCascadeWhere r - -deleteWhereCount :: (Sql.PersistEntity val, Sql.PersistEntityBackend val ~ Sql.SqlBackend) => [Sql.Filter val] -> EnvDatabaseDiscord d Int64 -deleteWhereCount r = liftSql $ Sql.deleteWhereCount r - -update :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> [Sql.Update record] -> EnvDatabaseDiscord d () -update r v = liftSql $ Sql.update r v - -updateWhere :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> [Sql.Update record] -> EnvDatabaseDiscord d () -updateWhere r v = liftSql $ Sql.updateWhere r v - -updateWhereCount :: (Sql.PersistEntity val, Sql.PersistEntityBackend val ~ Sql.SqlBackend) => [Sql.Filter val] -> [Sql.Update val] -> EnvDatabaseDiscord d Int64 -updateWhereCount r v = liftSql $ Sql.updateWhereCount r v - -updateGet :: (Sql.PersistEntity a, Sql.PersistEntityBackend a ~ Sql.SqlBackend) => Sql.Key a -> [Sql.Update a] -> EnvDatabaseDiscord d a -updateGet r v = liftSql $ Sql.updateGet r v - -upsert :: (Sql.OnlyOneUniqueKey record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> [Sql.Update record] -> EnvDatabaseDiscord d (Sql.Entity record) -upsert r v = liftSql $ Sql.upsert r v - -replace :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> record -> EnvDatabaseDiscord d () -replace r v = liftSql $ Sql.replace r v - -replaceUnique :: (Sql.PersistEntity record, Eq (Sql.Unique record), Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> record -> EnvDatabaseDiscord d (Maybe (Sql.Unique record)) -replaceUnique r v = liftSql $ Sql.replaceUnique r v - -count :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> EnvDatabaseDiscord d Int -count r = liftSql $ Sql.count r - -exists :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> EnvDatabaseDiscord d Bool -exists r = liftSql $ Sql.exists r - -selectFirst :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> [Sql.SelectOpt record] -> EnvDatabaseDiscord d (Maybe (Sql.Entity record)) -selectFirst r v = liftSql $ Sql.selectFirst r v - -selectKeysList :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> [Sql.SelectOpt record] -> EnvDatabaseDiscord d [Sql.Key record] -selectKeysList r v = liftSql $ Sql.selectKeysList r v - -selectList :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Filter record] -> [Sql.SelectOpt record] -> EnvDatabaseDiscord d [Sql.Entity record] -selectList r v = liftSql $ Sql.selectList r v - -get :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> EnvDatabaseDiscord d (Maybe record) -get v = liftSql $ Sql.get v - -getBy :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Unique record -> EnvDatabaseDiscord d (Maybe (Sql.Entity record)) -getBy v = liftSql $ Sql.getBy v - -getByValue :: (Sql.AtLeastOneUniqueKey record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => record -> EnvDatabaseDiscord d (Maybe (Sql.Entity record)) -getByValue v = liftSql $ Sql.getByValue v - -getEntity :: (Sql.PersistEntity e, Sql.PersistEntityBackend e ~ Sql.SqlBackend) => Sql.Key e -> EnvDatabaseDiscord d (Maybe (Sql.Entity e)) -getEntity v = liftSql $ Sql.getEntity v - -getFieldName :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.EntityField record typ -> EnvDatabaseDiscord d Text -getFieldName v = liftSql $ Sql.getFieldName v - -getJust :: (Sql.PersistEntity a, Sql.PersistEntityBackend a ~ Sql.SqlBackend) => Sql.Key a -> EnvDatabaseDiscord d a -getJust v = liftSql $ Sql.getJust v - -getJustEntity :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => Sql.Key record -> EnvDatabaseDiscord d (Sql.Entity record) -getJustEntity v = liftSql $ Sql.getJustEntity v - -getMany :: (Sql.PersistEntity record, Sql.PersistEntityBackend record ~ Sql.SqlBackend) => [Sql.Key record] -> EnvDatabaseDiscord d (Map (Sql.Key record) record) -getMany v = liftSql $ Sql.getMany v From d4f30462a4fce38a7f1cb714aeeec8891b24b76a Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 00:28:11 +0100 Subject: [PATCH 38/53] ormolu formatting --- src/Tablebot/Internal/Administration.hs | 2 +- src/Tablebot/Plugins/Administration.hs | 2 +- src/Tablebot/Plugins/Quote.hs | 10 +++++----- src/Tablebot/Plugins/Reminder.hs | 2 +- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 2 +- src/Tablebot/Plugins/Roll/Plugin.hs | 2 +- src/Tablebot/Utility/Discord.hs | 6 +++--- 7 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/Tablebot/Internal/Administration.hs b/src/Tablebot/Internal/Administration.hs index dbaac6d..bf76580 100644 --- a/src/Tablebot/Internal/Administration.hs +++ b/src/Tablebot/Internal/Administration.hs @@ -14,8 +14,8 @@ module Tablebot.Internal.Administration ) where -import Control.Monad.IO.Class (MonadIO) import Control.Monad (void, when) +import Control.Monad.IO.Class (MonadIO) import Data.List.Extra (isInfixOf, lower, trim) import Data.Text (Text, pack) import Database.Persist diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index 33cd94d..fb84677 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -19,6 +19,7 @@ import Data.Text (Text, pack) import qualified Data.Text as T import Data.Version (showVersion) import Database.Persist (Entity, Filter, entityVal, (==.)) +import qualified Database.Persist.Sqlite as Sql import Discord (stopDiscord) import Discord.Types import Language.Haskell.Printf (s) @@ -30,7 +31,6 @@ import Tablebot.Utility.Discord (sendMessage) import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.SmartParser import Text.RawString.QQ -import qualified Database.Persist.Sqlite as Sql -- | @SS@ denotes the type returned by the command setup. Here its unused. type SS = [Text] diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index 24ccd05..402edb5 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -13,15 +13,17 @@ -- quotes and then @!quote show n@ a particular quote. module Tablebot.Plugins.Quote (quotes) where -import Control.Monad.IO.Class (liftIO) import Control.Monad (join) +import Control.Monad.IO.Class (liftIO) import Data.Aeson import Data.Default (Default (def)) import Data.Functor ((<&>)) import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Text (Text, append, pack, unpack) import Data.Time.Clock.System (SystemTime (systemSeconds), getSystemTime, systemToUTCTime) -import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, (==.), toSqlKey, fromSqlKey) +import Data.Word +import Database.Persist.Sqlite (Entity (entityKey), Filter, SelectOpt (LimitTo, OffsetBy), entityVal, fromSqlKey, toSqlKey, (==.)) +import qualified Database.Persist.Sqlite as Sql import Database.Persist.TH import Discord (restCall) import Discord.Interactions @@ -36,13 +38,13 @@ import Tablebot.Utility.Discord getMessageLink, getPrecedingMessage, getReplyMessage, + idToWord, interactionResponseAutocomplete, interactionResponseCustomMessage, sendCustomMessage, sendMessage, toMention, toMention', - idToWord, wordToId, ) import Tablebot.Utility.Embed @@ -51,8 +53,6 @@ import Tablebot.Utility.Permission (requirePermission) import Tablebot.Utility.Search import Tablebot.Utility.SmartParser import Text.RawString.QQ (r) -import qualified Database.Persist.Sqlite as Sql -import Data.Word -- Our Quote table in the database. This is fairly standard for Persistent, -- however you should note the name of the migration made. diff --git a/src/Tablebot/Plugins/Reminder.hs b/src/Tablebot/Plugins/Reminder.hs index bb33584..0a50f84 100644 --- a/src/Tablebot/Plugins/Reminder.hs +++ b/src/Tablebot/Plugins/Reminder.hs @@ -31,7 +31,7 @@ import Duckling.Time.Types (InstantValue (InstantValue), SingleTimeValue (Simple import Tablebot.Utility import Tablebot.Utility.Discord (getMessage, sendChannelMessage, sendCustomReplyMessage, sendMessage, toTimestamp) import Tablebot.Utility.Permission (requirePermission) -import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), WithError (..), IntegralData(..)) +import Tablebot.Utility.SmartParser (IntegralData (..), PComm (parseComm), Quoted (Qu), RestOfInput (ROI), WithError (..)) import Text.RawString.QQ (r) -- Our Reminder table in the database. This is fairly standard for Persistent, diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index 370a873..5ca0f67 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -10,9 +10,9 @@ -- expressions. module Tablebot.Plugins.Roll.Dice.DiceEval (ParseShow (parseShow), evalProgram, evalList, evalInteger, evaluationException, propagateException, maximumRNG, maximumListLength) where +import Control.Monad (when) import Control.Monad.Exception (MonadException) import Control.Monad.State (MonadIO (liftIO), StateT, evalStateT, gets, modify) -import Control.Monad (when) import Data.List (foldl', genericDrop, genericReplicate, genericTake, sortBy) import Data.List.NonEmpty as NE (NonEmpty ((:|)), head, tail, (<|)) import Data.Map (Map, empty) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index cef900f..7abb5f5 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -9,8 +9,8 @@ -- A command that outputs the result of rolling the input dice. module Tablebot.Plugins.Roll.Plugin (rollPlugin) where -import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.ByteString.Lazy (toStrict) import Data.Default (Default (def)) import Data.Distribution (isValid) diff --git a/src/Tablebot/Utility/Discord.hs b/src/Tablebot/Utility/Discord.hs index 43b0a8e..b81cbfe 100644 --- a/src/Tablebot/Utility/Discord.hs +++ b/src/Tablebot/Utility/Discord.hs @@ -49,13 +49,14 @@ module Tablebot.Utility.Discord interactionResponseComponentsUpdateMessage, interactionResponseAutocomplete, idToWord, - wordToId + wordToId, ) where -import Control.Monad.IO.Class (liftIO) import Control.Monad.Exception (MonadException (throw)) +import Control.Monad.IO.Class (liftIO) import Data.Char (isDigit) +import Data.Coerce (coerce) import Data.Default (Default (def)) import Data.Foldable (msum) import Data.List ((\\)) @@ -75,7 +76,6 @@ import Tablebot.Internal.Cache (fillEmojiCache, lookupEmojiCache) import Tablebot.Internal.Embed (Embeddable (..)) import Tablebot.Utility (EnvDatabaseDiscord, MessageDetails, convertMessageFormatBasic, convertMessageFormatInteraction, liftDiscord, messageDetailsBasic) import Tablebot.Utility.Exception (BotException (..)) -import Data.Coerce ( coerce ) -- | @sendMessage@ sends the input message @t@ in the same channel as message -- @m@. From 7cbf2e416efd6ac9855caf09d102b40ae7e8c79b Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 18:19:45 +0100 Subject: [PATCH 39/53] add view patterns --- package.yaml | 1 + tablebot.cabal | 1 + 2 files changed, 2 insertions(+) diff --git a/package.yaml b/package.yaml index 0896e71..2993826 100644 --- a/package.yaml +++ b/package.yaml @@ -100,6 +100,7 @@ library: - TypeOperators - RankNTypes - BangPatterns + - ViewPatterns ghc-options: - -Wall diff --git a/tablebot.cabal b/tablebot.cabal index be18c7b..15c12c9 100644 --- a/tablebot.cabal +++ b/tablebot.cabal @@ -129,6 +129,7 @@ library TypeOperators RankNTypes BangPatterns + ViewPatterns ghc-options: -Wall build-depends: Chart From 9466cb86dc6a1e04a4b70e6c7d5fa93974284dd8 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 18:21:14 +0100 Subject: [PATCH 40/53] basic warning fixes --- src/Tablebot.hs | 2 -- src/Tablebot/Plugins/Administration.hs | 8 ++++---- src/Tablebot/Plugins/Flip.hs | 6 +++--- src/Tablebot/Plugins/Netrunner/Command/BanList.hs | 6 ++---- src/Tablebot/Plugins/Netrunner/Command/Search.hs | 2 +- src/Tablebot/Plugins/Quote.hs | 6 +++--- src/Tablebot/Plugins/Roll/Dice/DiceEval.hs | 6 ++++-- src/Tablebot/Plugins/Roll/Dice/DiceStats.hs | 2 +- src/Tablebot/Utility/SmartParser/Interactions.hs | 12 +++++++----- src/Tablebot/Utility/Utils.hs | 2 +- 10 files changed, 26 insertions(+), 26 deletions(-) diff --git a/src/Tablebot.hs b/src/Tablebot.hs index f534650..9813c88 100644 --- a/src/Tablebot.hs +++ b/src/Tablebot.hs @@ -27,7 +27,6 @@ import Data.Map as M (empty) import Data.Maybe (fromMaybe) import Data.Text (Text, pack) import qualified Data.Text as T -import Data.Text.Encoding (encodeUtf8) import Database.Persist.Sqlite ( runMigration, runSqlPool, @@ -38,7 +37,6 @@ import Discord.Internal.Rest import LoadEnv (loadEnv) import Paths_tablebot (version) import System.Environment (getEnv, lookupEnv) -import System.Exit (die) import Tablebot.Handler (eventHandler, killCron, runCron, submitApplicationCommands) import Tablebot.Internal.Administration ( ShutdownReason (Reload), diff --git a/src/Tablebot/Plugins/Administration.hs b/src/Tablebot/Plugins/Administration.hs index fb84677..263a286 100644 --- a/src/Tablebot/Plugins/Administration.hs +++ b/src/Tablebot/Plugins/Administration.hs @@ -70,11 +70,11 @@ addBlacklist pLabel m = requirePermission Superuser m $ do removeBlacklist :: String -> Message -> EnvDatabaseDiscord SS () removeBlacklist pLabel m = requirePermission Superuser m $ do extant <- liftSql $ Sql.selectKeysList [PluginBlacklistLabel ==. pLabel] [] - if not $ null extant - then do - _ <- liftSql $ Sql.delete (head extant) + case extant of + x : _ -> do + _ <- liftSql $ Sql.delete x sendMessage m "Plugin removed from blacklist. Please reload for it to take effect" - else sendMessage m "Plugin not in blacklist" + _ -> sendMessage m "Plugin not in blacklist" -- | @listBlacklist@ shows a list of the plugins eligible for disablement (those not starting with _), -- along with their current status. diff --git a/src/Tablebot/Plugins/Flip.hs b/src/Tablebot/Plugins/Flip.hs index 66a2d0d..93be3c5 100644 --- a/src/Tablebot/Plugins/Flip.hs +++ b/src/Tablebot/Plugins/Flip.hs @@ -28,9 +28,9 @@ flip = Command "flip" flipcomm [] flipcomm = do args <- (try quoted <|> nonSpaceWord) `sepBy` some space return $ \m -> do - c <- case length args of - 0 -> liftIO $ chooseOneWithDefault "" ["Heads", "Tails"] - _ -> liftIO $ chooseOneWithDefault (head args) args + c <- case args of + [] -> liftIO $ chooseOneWithDefault "" ["Heads", "Tails"] + a : _ -> liftIO $ chooseOneWithDefault a args sendMessage m $ pack c flipHelp :: HelpPage diff --git a/src/Tablebot/Plugins/Netrunner/Command/BanList.hs b/src/Tablebot/Plugins/Netrunner/Command/BanList.hs index d303376..7a5e28a 100644 --- a/src/Tablebot/Plugins/Netrunner/Command/BanList.hs +++ b/src/Tablebot/Plugins/Netrunner/Command/BanList.hs @@ -19,7 +19,7 @@ where import Data.List (nubBy) import Data.Map (keys) -import Data.Maybe (fromMaybe, mapMaybe) +import Data.Maybe (fromMaybe, listToMaybe, mapMaybe) import Data.Text (Text, intercalate, isInfixOf, toLower, unpack) import qualified Data.Text as T (length, take) import Tablebot.Plugins.Netrunner.Type.BanList (BanList (active, affectedCards, listId, name), CardBan (..)) @@ -81,9 +81,7 @@ listAffectedCards api b = in (pre, map format cCards, map format rCards) where find :: Text -> Maybe Card - find cCode = case filter ((Just cCode ==) . code) $ cards api of - [] -> Nothing - xs -> Just $ head xs + find cCode = listToMaybe $ filter ((Just cCode ==) . code) $ cards api format :: Card -> Text format card = symbol (toMwlStatus api b card) <> " " <> condense (fromMaybe "?" $ title card) condense :: Text -> Text diff --git a/src/Tablebot/Plugins/Netrunner/Command/Search.hs b/src/Tablebot/Plugins/Netrunner/Command/Search.hs index 33c8ccc..34e99d7 100644 --- a/src/Tablebot/Plugins/Netrunner/Command/Search.hs +++ b/src/Tablebot/Plugins/Netrunner/Command/Search.hs @@ -126,7 +126,7 @@ fixSearch api = mapMaybe fix -- format ("r", sep, v) = format ("u", sep, v) = Just $ QBool "u" sep uniqueness v format ("b", _, []) = Nothing - format ("b", sep, v) = Just $ QBan "b" sep $ fixBan $ head v + format ("b", sep, v : _) = Just $ QBan "b" sep $ fixBan v -- format ("z", sep, v) = format _ = Nothing cycleIndex :: Card -> Maybe Int diff --git a/src/Tablebot/Plugins/Quote.hs b/src/Tablebot/Plugins/Quote.hs index 402edb5..a84da78 100644 --- a/src/Tablebot/Plugins/Quote.hs +++ b/src/Tablebot/Plugins/Quote.hs @@ -222,10 +222,10 @@ filteredRandomQuote' quoteFilter errorMessage mb m = do then throwBot (GenericException "quote exception" (unpack errorMessage)) else do rindex <- liftIO $ randomRIO (0, num - 1) - key <- liftSql $ Sql.selectKeysList quoteFilter [OffsetBy rindex, LimitTo 1] - qu <- traverse (liftSql . Sql.get) $ listToMaybe key + keys <- liftSql $ Sql.selectKeysList quoteFilter [OffsetBy rindex, LimitTo 1] + qu <- traverse (\key -> fmap (,key) <$> liftSql (Sql.get key)) $ listToMaybe keys case join qu of - Just q -> renderQuoteMessage q (fromSqlKey $ head key) mb m + Just (q, key) -> renderQuoteMessage q (fromSqlKey key) mb m Nothing -> throwBot (GenericException "quote exception" (unpack errorMessage)) -- | @addQuote@, which looks for a message of the form diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs index 5ca0f67..ab98561 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceEval.hs @@ -13,7 +13,7 @@ module Tablebot.Plugins.Roll.Dice.DiceEval (ParseShow (parseShow), evalProgram, import Control.Monad (when) import Control.Monad.Exception (MonadException) import Control.Monad.State (MonadIO (liftIO), StateT, evalStateT, gets, modify) -import Data.List (foldl', genericDrop, genericReplicate, genericTake, sortBy) +import Data.List (genericDrop, genericReplicate, genericTake, sortBy) import Data.List.NonEmpty as NE (NonEmpty ((:|)), head, tail, (<|)) import Data.Map (Map, empty) import qualified Data.Map as M @@ -161,7 +161,9 @@ propagateException t a = catchBot a handleException handleException (EvaluationException msg' locs) = throwBot (EvaluationException msg' (addIfNotIn locs)) handleException e = throwBot e pa = unpack t - addIfNotIn locs = if null locs || pa /= Prelude.head locs then pa : locs else locs + addIfNotIn locs = case locs of + x : _ | pa == x -> locs + _ -> pa : locs -- | This type class evaluates an item and returns a list of integers (with -- their representations if valid). diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs index b1f60aa..9e3bb20 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStats.hs @@ -59,7 +59,7 @@ rangeListValues lv = do head' [] = [] head' (x : _) = [x] getHeads xs = (\(xs', p) -> (,p) <$> head' xs') =<< xs - getTails xs = first tail <$> xs + getTails xs = first (drop 1) <$> xs zip' xs = getHeads xs : zip' (getTails xs) -- | Type class to get the overall range of a value. diff --git a/src/Tablebot/Utility/SmartParser/Interactions.hs b/src/Tablebot/Utility/SmartParser/Interactions.hs index 078e973..50d2963 100644 --- a/src/Tablebot/Utility/SmartParser/Interactions.hs +++ b/src/Tablebot/Utility/SmartParser/Interactions.hs @@ -46,11 +46,13 @@ makeApplicationCommandPair name desc f = do -- a function's type. makeSlashCommand :: (MakeAppComm t) => Text -> Text -> Proxy t -> Maybe CreateApplicationCommand makeSlashCommand name desc p = - createChatInput name desc >>= \cac -> - return $ - cac - { createOptions = Just $ OptionsValues $ makeAppComm p - } + createChatInput name desc >>= \case + cac@CreateApplicationCommandChatInput {} -> + return $ + cac + { createOptions = Just $ OptionsValues $ makeAppComm p + } + _ -> Nothing -- | Create a series of command option values from the given types. -- diff --git a/src/Tablebot/Utility/Utils.hs b/src/Tablebot/Utility/Utils.hs index f42bce3..c1c5701 100644 --- a/src/Tablebot/Utility/Utils.hs +++ b/src/Tablebot/Utility/Utils.hs @@ -13,7 +13,7 @@ import Control.Monad (when) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text, filter, toLower) import Data.Text.ICU.Char (Bool_ (Diacritic), property) -import Data.Text.ICU.Normalize (NormalizationMode (NFD), normalize) +import Data.Text.ICU.Normalize2 (NormalizationMode (NFD), normalize) import Data.Text.Lazy (toStrict) import Data.Text.Lazy.Builder (toLazyText) import Data.Text.Lazy.Builder.Int (decimal) From 4ecf53334d41b6f3a1fe8531fffeeadb9227e6cb Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 18:21:36 +0100 Subject: [PATCH 41/53] use nonempty here to avoid `head` --- src/Tablebot/Internal/Handler/Command.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Tablebot/Internal/Handler/Command.hs b/src/Tablebot/Internal/Handler/Command.hs index 2adc979..eb5878d 100644 --- a/src/Tablebot/Internal/Handler/Command.hs +++ b/src/Tablebot/Internal/Handler/Command.hs @@ -17,6 +17,7 @@ module Tablebot.Internal.Handler.Command ) where +import qualified Data.Functor as Functor import Data.List (find) import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes) @@ -125,7 +126,7 @@ instance ShowErrorComponent ReadableError where makeBundleReadable :: ParseErrorBundle Text Void -> (ParseErrorBundle Text ReadableError, String) makeBundleReadable (ParseErrorBundle errs state) = - let (errors, title) = NE.unzip $ NE.map makeReadable errs + let (errors, title) = Functor.unzip $ NE.map makeReadable errs in (ParseErrorBundle errors state, getTitle $ NE.toList title) where getTitle :: [Maybe String] -> String @@ -133,10 +134,9 @@ makeBundleReadable (ParseErrorBundle errs state) = getTitle titles = case filter (not . null) $ catMaybes titles of -- therefore, `x` is nonempty, so `lines x` is nonempty, meaning that `head (lines x)` is fine, -- since `lines x` is nonempty for nonempty input. - (x : xs) -> - let title = head (lines x) - in if null xs then title else title ++ " (and " ++ show (length xs) ++ " more)" - [] -> "Parser Error!" + ((NE.nonEmpty . lines -> Just (title NE.:| _)) : xs) -> + if null xs then title else title ++ " (and " ++ show (length xs) ++ " more)" + _ -> "Parser Error!" -- | Transform our errors into more useful ones. -- This uses the Label hidden within each error to build an error message, From d294d964bc505d1b55565e737591a15c68301ba7 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 18:24:10 +0100 Subject: [PATCH 42/53] use parser for fromMention, invert module dep and move inlineCommandHelper --- src/Tablebot/Plugins/Netrunner/Plugin.hs | 4 +-- src/Tablebot/Plugins/Roll/Plugin.hs | 2 +- src/Tablebot/Utility/Discord.hs | 39 +++++++++++++++--------- src/Tablebot/Utility/Parser.hs | 38 +++++++++++------------ 4 files changed, 44 insertions(+), 39 deletions(-) diff --git a/src/Tablebot/Plugins/Netrunner/Plugin.hs b/src/Tablebot/Plugins/Netrunner/Plugin.hs index 3c2d297..3dd6e42 100644 --- a/src/Tablebot/Plugins/Netrunner/Plugin.hs +++ b/src/Tablebot/Plugins/Netrunner/Plugin.hs @@ -29,9 +29,9 @@ import Tablebot.Plugins.Netrunner.Utility.Card (toText) import Tablebot.Plugins.Netrunner.Utility.Embed import Tablebot.Plugins.Netrunner.Utility.NrApi (getNrApi) import Tablebot.Utility -import Tablebot.Utility.Discord (formatFromEmojiName, sendEmbedMessage, sendMessage) +import Tablebot.Utility.Discord (formatFromEmojiName, inlineCommandHelper, sendEmbedMessage, sendMessage) import Tablebot.Utility.Embed (addColour) -import Tablebot.Utility.Parser (inlineCommandHelper, keyValue, keyValuesSepOn) +import Tablebot.Utility.Parser (keyValue, keyValuesSepOn) import Tablebot.Utility.SmartParser (PComm (parseComm), Quoted (Qu), RestOfInput (ROI), RestOfInput1 (ROI1), WithError (WErr)) import Tablebot.Utility.Types () import Text.Megaparsec (anySingleBut, some) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 7abb5f5..5de537f 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -31,7 +31,7 @@ import Tablebot.Plugins.Roll.Dice.DiceData import Tablebot.Plugins.Roll.Dice.DiceStats (getStats, rangeExpr) import Tablebot.Plugins.Roll.Dice.DiceStatsBase (distributionByteString) import Tablebot.Utility -import Tablebot.Utility.Discord (Format (Code), formatText, sendCustomMessage, sendMessage, toMention') +import Tablebot.Utility.Discord (Format (Code), formatText, inlineCommandHelper, sendCustomMessage, sendMessage, toMention') import Tablebot.Utility.Exception (BotException (EvaluationException), throwBot) import Tablebot.Utility.Parser import Tablebot.Utility.SmartParser diff --git a/src/Tablebot/Utility/Discord.hs b/src/Tablebot/Utility/Discord.hs index b81cbfe..62a1617 100644 --- a/src/Tablebot/Utility/Discord.hs +++ b/src/Tablebot/Utility/Discord.hs @@ -27,7 +27,6 @@ module Tablebot.Utility.Discord toMention, toMention', fromMention, - fromMentionStr, toTimestamp, toTimestamp', formatEmoji, @@ -48,22 +47,23 @@ module Tablebot.Utility.Discord interactionResponseCustomMessage, interactionResponseComponentsUpdateMessage, interactionResponseAutocomplete, + inlineCommandHelper, idToWord, wordToId, ) where +import Control.Monad import Control.Monad.Exception (MonadException (throw)) import Control.Monad.IO.Class (liftIO) -import Data.Char (isDigit) import Data.Coerce (coerce) import Data.Default (Default (def)) -import Data.Foldable (msum) import Data.List ((\\)) import Data.Map.Strict (keys) import Data.Maybe (listToMaybe) import Data.String (IsString (fromString)) -import Data.Text (Text, pack, unpack) +import Data.Text (Text, pack) +import qualified Data.Text as T import Data.Time.Clock (nominalDiffTimeToSeconds) import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) import Discord (Cache (cacheGuilds), DiscordHandler, RestCallErrorCode, readCache, restCall) @@ -74,8 +74,11 @@ import GHC.Word (Word64) import System.Environment (lookupEnv) import Tablebot.Internal.Cache (fillEmojiCache, lookupEmojiCache) import Tablebot.Internal.Embed (Embeddable (..)) -import Tablebot.Utility (EnvDatabaseDiscord, MessageDetails, convertMessageFormatBasic, convertMessageFormatInteraction, liftDiscord, messageDetailsBasic) +import Tablebot.Utility import Tablebot.Utility.Exception (BotException (..)) +import Tablebot.Utility.Parser +import Text.Megaparsec +import Text.Megaparsec.Char (string) -- | @sendMessage@ sends the input message @t@ in the same channel as message -- @m@. @@ -308,16 +311,7 @@ toMention' u = "<@!" <> pack (show u) <> ">" -- | @fromMention@ converts some text into what could be a userid (which isn't checked -- for correctness above getting rid of triangle brackets, '@', and the optional '!') fromMention :: Text -> Maybe UserId -fromMention = fromMentionStr . unpack - --- | Try to get the userid from a given string. -fromMentionStr :: String -> Maybe UserId -fromMentionStr user - | length user < 4 || head user /= '<' || last user /= '>' || (head . tail) user /= '@' || (head stripToNum /= '!' && (not . isDigit) (head stripToNum)) = Nothing - | all isDigit (tail stripToNum) = Just $ if head stripToNum == '!' then read (tail stripToNum) else read stripToNum - | otherwise = Nothing - where - stripToNum = (init . tail . tail) user +fromMention = parseMaybe parseMentionUserId -- | Data types for different time formats. data TimeFormat = Default | ShortTime | LongTime | ShortDate | LongDate | ShortDateTime | LongDateTime | Relative deriving (Show, Enum, Eq) @@ -459,3 +453,18 @@ wordToId = coerce idToWord :: DiscordId a -> Word64 idToWord = coerce + +-- | For helping to create inline commands. Takes the opening characters, closing +-- characters, a parser to get a value `e`, and an action that takes that `e` and a +-- message and produces a DatabaseDiscord effect. +inlineCommandHelper :: Text -> Text -> Parser e -> (e -> Message -> EnvDatabaseDiscord d ()) -> EnvInlineCommand d +inlineCommandHelper open close p action = + InlineCommand + ( do + getExprs <- some (try $ skipManyTill anySingle (string open *> skipSpace *> (((Right <$> try p) <* skipSpace <* string close) <|> (Left . T.pack <$> manyTill anySingle (string close))))) + return $ \m -> mapM_ (`action'` m) (take maxInlineCommands getExprs) + ) + where + maxInlineCommands = 3 + action' (Right p') m = action p' m + action' (Left _) m = void $ reactToMessage m "x" diff --git a/src/Tablebot/Utility/Parser.hs b/src/Tablebot/Utility/Parser.hs index f50b327..c2053d2 100644 --- a/src/Tablebot/Utility/Parser.hs +++ b/src/Tablebot/Utility/Parser.hs @@ -11,14 +11,17 @@ module Tablebot.Utility.Parser where import Data.Char (isDigit, isLetter, isSpace) -import Data.Functor (void, ($>)) +import Data.Functor (($>)) import Data.Text (Text) -import qualified Data.Text as T -import Discord.Internal.Rest (Message) -import Tablebot.Utility -import Tablebot.Utility.Discord (reactToMessage) +import Discord.Types + ( DiscordId (..), + Snowflake (..), + UserId, + ) +import Tablebot.Utility.Types (Parser) import Text.Megaparsec -import Text.Megaparsec.Char (char, string) +import Text.Megaparsec.Char (char) +import Text.Read (readMaybe) space :: Parser () space = satisfy isSpace $> () @@ -171,21 +174,6 @@ double = do <|> return "" return (read (minus : digits ++ decimal)) --- | For helping to create inline commands. Takes the opening characters, closing --- characters, a parser to get a value `e`, and an action that takes that `e` and a --- message and produces a DatabaseDiscord effect. -inlineCommandHelper :: Text -> Text -> Parser e -> (e -> Message -> EnvDatabaseDiscord d ()) -> EnvInlineCommand d -inlineCommandHelper open close p action = - InlineCommand - ( do - getExprs <- some (try $ skipManyTill anySingle (string open *> skipSpace *> (((Right <$> try p) <* skipSpace <* string close) <|> (Left . T.pack <$> manyTill anySingle (string close))))) - return $ \m -> mapM_ (`action'` m) (take maxInlineCommands getExprs) - ) - where - maxInlineCommands = 3 - action' (Right p') m = action p' m - action' (Left _) m = void $ reactToMessage m "x" - -- | Parse 0 or more comma separated values. parseCommaSeparated :: Parser a -> Parser [a] parseCommaSeparated p = do @@ -214,3 +202,11 @@ instance (ParseShow a, ParseShow b) => ParseShow (Either a b) where instance ParseShow Text where parseShow t = t + +-- | Try to get the userid from a given string. +parseMentionUserId :: Parser UserId +parseMentionUserId = do + digits <- between (chunk "<@" <* optional (single '!')) (single '>') (some digit) -- single '<' *> single '@' *> single '!' *> some (satisy ) <* single '>' + case readMaybe digits of + Just i -> pure $ DiscordId $ Snowflake $ i + Nothing -> fail $ "could not read user id: " <> show digits From b05099fac11ffcd018c08877eb983c15731ae736 Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Wed, 17 Sep 2025 18:24:39 +0100 Subject: [PATCH 43/53] guarantee nonemptiness to avoid head --- src/Tablebot/Plugins/Roll/Plugin.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 5de537f..7f35879 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -14,6 +14,7 @@ import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.ByteString.Lazy (toStrict) import Data.Default (Default (def)) import Data.Distribution (isValid) +import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text, intercalate, pack, replicate, unpack) import qualified Data.Text as T @@ -195,18 +196,17 @@ To see a full list of uses, options and limitations, please go to rpgSystems') +genchar = Command "genchar" (snd $ NE.head rpgSystems') (toCommand <$> NE.toList rpgSystems') where doDiceRoll (nm, lv) = (nm, parseComm $ rollDice' (Just (Program [] (Left lv))) (Just (Qu ("genchar for " <> nm)))) rpgSystems' = doDiceRoll <$> rpgSystems toCommand (nm, ps) = Command nm ps [] -- | List of supported genchar systems and the dice used to roll for them -rpgSystems :: [(Text, ListValues)] +rpgSystems :: NE.NonEmpty (Text, ListValues) rpgSystems = - [ ("dnd", MultipleValues (Value 6) (DiceBase (Dice (NBase (Value 4)) (Die (Value 6)) (Just (DieOpRecur (DieOpOptionKD Drop (Low (Value 1))) Nothing))))), - ("wfrp", MultipleValues (Value 8) (NBase (NBParen (Paren (Expr (BinOp (promote (Value 20)) [(Add, promote (Die (Value 10)))])))))) - ] + ("dnd", MultipleValues (Value 6) (DiceBase (Dice (NBase (Value 4)) (Die (Value 6)) (Just (DieOpRecur (DieOpOptionKD Drop (Low (Value 1))) Nothing))))) + NE.:| [("wfrp", MultipleValues (Value 8) (NBase (NBParen (Paren (Expr (BinOp (promote (Value 20)) [(Add, promote (Die (Value 10)))]))))))] -- | Small help page for gen char. gencharHelp :: HelpPage @@ -215,7 +215,7 @@ gencharHelp = "genchar" [] "generate stat arrays for some systems" - ("**Genchar**\nCan be used to generate stat arrays for certain systems.\n\nCurrently supported systems: " <> intercalate ", " (fst <$> rpgSystems) <> ".\n\n*Usage:* `genchar`, `genchar dnd`") + ("**Genchar**\nCan be used to generate stat arrays for certain systems.\n\nCurrently supported systems: " <> intercalate ", " (fst <$> NE.toList rpgSystems) <> ".\n\n*Usage:* `genchar`, `genchar dnd`") [] None From d01404f83fce7e23789eb10a50bd3d5c1a4aa5be Mon Sep 17 00:00:00 2001 From: L0neGamer Date: Thu, 18 Sep 2025 19:29:19 +0100 Subject: [PATCH 44/53] treat infinite stream like an infinite stream --- .../Plugins/Roll/Dice/DiceStatsBase.hs | 27 ++++++++++++++----- 1 file changed, 20 insertions(+), 7 deletions(-) diff --git a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs index bfbda8f..09c5f52 100644 --- a/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs +++ b/src/Tablebot/Plugins/Roll/Dice/DiceStatsBase.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DeriveFunctor #-} + -- | -- Module : Tablebot.Plugins.Roll.Dice.DiceStatsBase -- Description : The basics for dice stats @@ -106,31 +108,42 @@ scaledIntAxis' r@(minI, maxI) _ = makeAxis (_la_labelf lap) ((minI - 1) : (maxI ) gridvs = labelvs +data Stream a = a :|< Stream a + deriving (Functor) + +prependList :: [a] -> Stream a -> Stream a +prependList [] stream = stream +prependList (a : as) stream = a :|< prependList as stream + +spanStream :: (a -> Bool) -> Stream a -> ([a], Stream a) +spanStream f stream@(a :|< as) + | f a = first (a :) $ spanStream f as + | otherwise = ([], stream) + -- | Taken and modified from -- https://hackage.haskell.org/package/Chart-1.9.3/docs/src/Graphics.Rendering.Chart.Axis.Int.html#stepsInt stepsInt' :: Integer -> (Integer, Integer) -> [Integer] stepsInt' nSteps range = bestSize (goodness alt0) alt0 alts where - bestSize n a (a' : as) = + bestSize n a (a' :|< as) = let n' = goodness a' in if n' < n then bestSize n' a' as else a - bestSize _ _ [] = [] goodness vs = abs (genericLength vs - nSteps) - (alt0 : alts) = map (`steps` range) sampleSteps' + (alt0 :|< alts) = fmap (`steps` range) sampleSteps' -- throw away sampleSteps that are definitely too small as -- they takes a long time to process sampleSteps' = let rangeMag = (snd range - fst range) - (s1, s2) = span (< (rangeMag `div` nSteps)) sampleSteps - in (reverse . take 5 . reverse) s1 ++ s2 + (s1, s2) = spanStream (< (rangeMag `div` nSteps)) sampleSteps + in (reverse . take 5 . reverse) s1 `prependList` s2 -- generate all possible step sizes - sampleSteps = [1, 2, 5] ++ sampleSteps1 - sampleSteps1 = [10, 20, 25, 50] ++ map (* 10) sampleSteps1 + sampleSteps = [1, 2, 5] `prependList` sampleSteps1 + sampleSteps1 = [10, 20, 25, 50] `prependList` fmap (* 10) sampleSteps1 steps :: Integer -> (Integer, Integer) -> [Integer] steps size' (minV, maxV) = takeWhile (< b) [a, a + size' ..] ++ [b] From c48667df47fcca02353a6bb5a9dd25b7b929fe25 Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:13:24 +0100 Subject: [PATCH 45/53] Changing Duckling dependency format --- stack.yaml | 2 +- stack.yaml.lock | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/stack.yaml b/stack.yaml index 02c0628..398de29 100644 --- a/stack.yaml +++ b/stack.yaml @@ -48,7 +48,7 @@ extra-deps: - svg-builder-0.1.1 - git: https://github.com/L0neGamer/haskell-distribution.git commit: 569d6452e4bffedb2c0d3795885fccdb22a4d29d -- git: git@github.com:L0neGamer/duckling.git +- git: https://github.com/L0neGamer/duckling.git commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 allow-newer-deps: diff --git a/stack.yaml.lock b/stack.yaml.lock index e3fb79f..a53e483 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -52,7 +52,7 @@ packages: git: https://github.com/L0neGamer/haskell-distribution.git - completed: commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 - git: git@github.com:L0neGamer/duckling.git + git: https://github.com/L0neGamer/duckling.git name: duckling pantry-tree: sha256: 126902871d2ae27e2ac4a88a07f04a4c3b7bff3f0fdf067d8d9226136002ff51 @@ -60,7 +60,7 @@ packages: version: 0.2.0.1 original: commit: f22e3cdd7b77977fe3e9ec75fccd9a0f79c47f97 - git: git@github.com:L0neGamer/duckling.git + git: https://github.com/L0neGamer/duckling.git snapshots: - completed: sha256: 057c5a66404132b661211de21bb4490f6df89c162752a17f0df5a0959381b869 From 9d68bc73336c94c97e8511482be2213cff840f6e Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:20:16 +0100 Subject: [PATCH 46/53] Updating Dockerfile --- Dockerfile | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Dockerfile b/Dockerfile index 2d8fe70..43cf5d2 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,5 +1,5 @@ -# stack resolver 18.18 uses ghc 8.10.7 -FROM haskell:8.10.7 as build +# stack resolver 18.18 uses ghc 9.12.2 +FROM haskell:9.12.2 as build RUN mkdir -p /tablebot/build WORKDIR /tablebot/build @@ -16,7 +16,7 @@ RUN stack build --system-ghc RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin -FROM haskell:8.10.7-slim as app +FROM haskell:9.12.2-slim as app # system runtime deps RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ From 2088e3cb7653ff9bd2928b504ea0c2ea1dddc0ea Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:25:57 +0100 Subject: [PATCH 47/53] Fixing Dockerfile. --- Dockerfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Dockerfile b/Dockerfile index 43cf5d2..a3323cd 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,5 +1,5 @@ # stack resolver 18.18 uses ghc 9.12.2 -FROM haskell:9.12.2 as build +FROM haskell:9.12.2-bookworm as build RUN mkdir -p /tablebot/build WORKDIR /tablebot/build @@ -16,7 +16,7 @@ RUN stack build --system-ghc RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin -FROM haskell:9.12.2-slim as app +FROM haskell:9.12.2-slim-bookworm as app # system runtime deps RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ From 7114eadcf82d716b9b9a6ea5785a13917b18dc8b Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:28:07 +0100 Subject: [PATCH 48/53] Trying to fix Dockerfile again --- Dockerfile | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/Dockerfile b/Dockerfile index a3323cd..37c95ef 100644 --- a/Dockerfile +++ b/Dockerfile @@ -4,8 +4,7 @@ RUN mkdir -p /tablebot/build WORKDIR /tablebot/build # system lib dependencies -RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ - apt-get update -qq && \ +RUN apt-get update -qq && \ apt-get install -qq -y libpcre3-dev build-essential pkg-config libicu-dev --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* @@ -19,8 +18,7 @@ RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin FROM haskell:9.12.2-slim-bookworm as app # system runtime deps -RUN sed -i s/deb.debian.org/archive.debian.org/g /etc/apt/sources.list && \ - apt-get update -qq && \ +RUN apt-get update -qq && \ apt-get install -qq -y libpcre3 libicu63 --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* From 78480ec5a1c10ead3a4c6e8cc144ed321bf6ff33 Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:36:49 +0100 Subject: [PATCH 49/53] Fixing Dockerfile, I think for good this time --- Dockerfile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Dockerfile b/Dockerfile index 37c95ef..d5d3219 100644 --- a/Dockerfile +++ b/Dockerfile @@ -17,9 +17,9 @@ RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin FROM haskell:9.12.2-slim-bookworm as app -# system runtime deps +# system runtime deps - if this command fails, check libicu version (https://packages.debian.org/search?keywords=libicu&searchon=names&suite=bookworm§ion=all) and upgrade if necessary RUN apt-get update -qq && \ - apt-get install -qq -y libpcre3 libicu63 --fix-missing --no-install-recommends && \ + apt-get install -qq -y libpcre3 libicu72 --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* From 18470fd1648483d1f9081412a26d1cefb1a4c5b4 Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:42:55 +0100 Subject: [PATCH 50/53] Fixing properly, and adding helpful comments --- Dockerfile | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/Dockerfile b/Dockerfile index d5d3219..c0aaad2 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,5 +1,5 @@ -# stack resolver 18.18 uses ghc 9.12.2 -FROM haskell:9.12.2-bookworm as build +# stack resolver 24.10 uses ghc 9.10.2 - when upgrading LTS version in stack.yaml, check Haskell version on https://www.stackage.org/ and check which Debian release is available on https://hub.docker.com/_/haskell/ +FROM haskell:9.10.2-bullseye as build RUN mkdir -p /tablebot/build WORKDIR /tablebot/build @@ -15,9 +15,10 @@ RUN stack build --system-ghc RUN mv "$(stack path --local-install-root --system-ghc)/bin" /tablebot/build/bin -FROM haskell:9.12.2-slim-bookworm as app +# ensure this matches first FROM +FROM haskell:9.10.2-slim-bullseye as app -# system runtime deps - if this command fails, check libicu version (https://packages.debian.org/search?keywords=libicu&searchon=names&suite=bookworm§ion=all) and upgrade if necessary +# system runtime deps - if this command fails, check libicu version (https://packages.debian.org/index) and upgrade if necessary RUN apt-get update -qq && \ apt-get install -qq -y libpcre3 libicu72 --fix-missing --no-install-recommends && \ apt-get clean && \ From e167b2e311e8e8482294b6be8c4e7beeadb3df0b Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 22:45:06 +0100 Subject: [PATCH 51/53] Downgrading libicu version for bullseye Debian --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index c0aaad2..a6507be 100644 --- a/Dockerfile +++ b/Dockerfile @@ -20,7 +20,7 @@ FROM haskell:9.10.2-slim-bullseye as app # system runtime deps - if this command fails, check libicu version (https://packages.debian.org/index) and upgrade if necessary RUN apt-get update -qq && \ - apt-get install -qq -y libpcre3 libicu72 --fix-missing --no-install-recommends && \ + apt-get install -qq -y libpcre3 libicu67 --fix-missing --no-install-recommends && \ apt-get clean && \ rm -rf /var/lib/apt/lists/* /tmp/* /var/tmp/* From 90da3e52e3088c5898d3b8705a081fa14124e1f6 Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 23:36:18 +0100 Subject: [PATCH 52/53] Making the timeout for the dice stats command an environmental variable --- .env.example | 1 + README.md | 1 + src/Tablebot/Plugins/Roll/Plugin.hs | 7 ++++--- 3 files changed, 6 insertions(+), 3 deletions(-) diff --git a/.env.example b/.env.example index 2d641d2..b5fb462 100644 --- a/.env.example +++ b/.env.example @@ -9,4 +9,5 @@ SUPERUSER_GROUP=147258369147258369 SERVER_ID=314159265358979323 ALLOW_GIT_UPDATE=False EMOJI_SERVERS=[121213131414151516] +STATS_TIMEOUT=20 # NOTE: YOU MUST HAVE A NEWLINE AT THE END OF THE FILE diff --git a/README.md b/README.md index e8ee3b9..55a5a23 100644 --- a/README.md +++ b/README.md @@ -26,6 +26,7 @@ Create a `.env` file containing the following keys. Consult `.env.example` if yo * `SERVER_ID` (optional) - either `global` or the id of the server the bot will mainly be deployed in. Application commands will be registered here. If absent, application commands won't be registered. * `EMOJI_SERVERS` (optional) - a list of server IDs that the bot will search for emoji within. +* `STATS_TIMEOUT` (optional) - an integer value that determines the maximum number of seconds that the bot will perform dice stats calculations for before timing out. * `ALLOW_GIT_UPDATE` (optional) - a `true` or `false` value that determines whether the bot can automatically load data from the repository. **Warning!** Be very careful with setting this to true; if you haven't set up permissions properly on your repo and your discord servers then things can go wrong! diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 54b023d..58421ff 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -23,6 +23,7 @@ import Discord.Interactions import Discord.Internal.Rest.Channel (ChannelRequest (..), MessageDetailedOpts (..)) import Discord.Types (ActionRow (..), Button (..), Message (..), User (..), UserId, mkButton, mkEmoji) import System.Timeout (timeout) +import System.Environment (lookupEnv) import Tablebot.Internal.Cache (getFontMap) import Tablebot.Internal.Handler.Command (parseValue) import Tablebot.Plugins.Roll.Dice @@ -36,6 +37,7 @@ import Tablebot.Utility.Parser import Tablebot.Utility.SmartParser import Text.Megaparsec import Text.RawString.QQ (r) +import Text.Read (readMaybe) -- | The basic execution function for rolling dice. Both the expression and message are -- optional. If the expression is not given, then the default roll is used. @@ -223,9 +225,6 @@ gencharHelp = statsCommand :: Command statsCommand = Command "stats" statsCommandParser [] where - oneSecond = 1000000 - tenSeconds = 10 * oneSecond - timeoutTime = tenSeconds statsCommandParser :: Parser (Message -> DatabaseDiscord ()) statsCommandParser = do firstE <- pars @@ -233,6 +232,8 @@ statsCommand = Command "stats" statsCommandParser [] return $ statsCommand' (firstE : restEs) statsCommand' :: [Expr] -> Message -> DatabaseDiscord () statsCommand' es m = do + let oneSecond = 1000000 + timeoutTime <- liftIO $ (oneSecond *) . fromMaybe 10 . readMaybe . fromMaybe "10" <$> lookupEnv "STATS_TIMEOUT" mrange' <- liftIO $ timeout timeoutTime $ mapM (\e -> rangeExpr e >>= \re -> re `seq` return (re, parseShow e)) es case mrange' of Nothing -> throwBot (EvaluationException "Timed out calculating statistics" []) From bef80dc34aad0e5a1c7163dfc1199d7c71724594 Mon Sep 17 00:00:00 2001 From: Bongo50 Date: Sat, 20 Sep 2025 23:37:36 +0100 Subject: [PATCH 53/53] Ormolu --- src/Tablebot/Plugins/Roll/Plugin.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Tablebot/Plugins/Roll/Plugin.hs b/src/Tablebot/Plugins/Roll/Plugin.hs index 58421ff..273cc27 100644 --- a/src/Tablebot/Plugins/Roll/Plugin.hs +++ b/src/Tablebot/Plugins/Roll/Plugin.hs @@ -22,8 +22,8 @@ import Discord.Interactions ) import Discord.Internal.Rest.Channel (ChannelRequest (..), MessageDetailedOpts (..)) import Discord.Types (ActionRow (..), Button (..), Message (..), User (..), UserId, mkButton, mkEmoji) -import System.Timeout (timeout) import System.Environment (lookupEnv) +import System.Timeout (timeout) import Tablebot.Internal.Cache (getFontMap) import Tablebot.Internal.Handler.Command (parseValue) import Tablebot.Plugins.Roll.Dice