Use utility-ht

docs/developers/CHANGELOG.md

@@ -1,5 +1,8 @@
 # 📅 Revision history for HelPA
 
+## 0.4.6.5 -- 2025-01-23
+* Use `utility-ht`
+
 ## 0.4.6.4 -- 2025-01-21
 * Refactor tests
 

helpa.cabal

@@ -1,7 +1,7 @@
 cabal-version:         2.4
 
 name:                  helpa
-version:               0.4.6.3
+version:               0.4.6.5
 
 synopsis:              HELPA - Heavenly Esoteric Little Portable Assembler to esoteric languages
 description:           Please see the README on GitHub at <https://github.com/helvm/helpa#readme>
@@ -188,6 +188,7 @@ library
     , mtl
     , split
     , type-operators
+    , utility-ht
   ghc-options:
 
 executable helpa

hs/src/HelVM/HelPA/Assembler/AsmParserExtra.hs

@@ -4,6 +4,7 @@ import           HelVM.HelPA.Assembler.Value
 
 import           HelVM.HelIO.ReadText
 
+import           Control.Applicative.HT
 import           Data.Attoparsec.Combinator
 import           Data.Attoparsec.Text
 
@@ -108,10 +109,10 @@ dotIdentifierParser :: Parser Identifier
 dotIdentifierParser = char '.' *> identifierParser <* skipHorizontalSpace
 
 identifierParser :: Parser Identifier
-identifierParser = toIdentifier <$> liftA2 (:) letter_ (many alphaNum_)
+identifierParser = toIdentifier <$> lift2 (:) letter_ (many alphaNum_)
 
 fileNameParser :: Parser Identifier
-fileNameParser = toIdentifier <$> liftA2 (:) letter (many alphaNumDot_)
+fileNameParser = toIdentifier <$> lift2 (:) letter (many alphaNumDot_)
 
 letter_ :: Parser Char
 letter_ = satisfy isAlpha_ <?> "letter_"

hs/src/HelVM/HelPA/Assemblers/Backend/ASQ/Eigenratios/AsmParser.hs

@@ -11,6 +11,7 @@ import           HelVM.HelPA.Assembler.Value
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Control.Type.Operator
 
 import           Data.Attoparsec.Text
@@ -22,7 +23,7 @@ instructionListParser :: Parser InstructionList
 instructionListParser = skipManyComment *> skipHorizontalSpace *> many (instructionParser <* skipHorizontalSpace <* skipManyComment)
 
 instructionParser :: Parser Instruction
-instructionParser = liftA2 Instruction labelMaybeParser commandMaybeParser <* endLineParser
+instructionParser = lift2 Instruction labelMaybeParser commandMaybeParser <* endLineParser
 
 labelMaybeParser :: Parser $ Maybe Label
 labelMaybeParser = optional labelParser
@@ -37,7 +38,7 @@ dataParser :: Parser Command
 dataParser = stringWithSpaceParser "data" *> (Data <$> signedIntegerValueWithSpaceParser)
 
 codeParser :: Parser Command
-codeParser = stringWithSpaceParser "subleq" *> liftA3 Code signedIntegerValueWithSpaceParser signedIntegerValueWithSpaceParser (optional signedIntegerValueWithSpaceParser)
+codeParser = stringWithSpaceParser "subleq" *> lift3 Code signedIntegerValueWithSpaceParser signedIntegerValueWithSpaceParser (optional signedIntegerValueWithSpaceParser)
 
 stringWithSpaceParser :: Text -> Parser Text
 stringWithSpaceParser s = string s <* skipHorizontalSpace

hs/src/HelVM/HelPA/Assemblers/Backend/ASQ/EsoLangs/AsmParser.hs

@@ -10,6 +10,7 @@ import           HelVM.HelPA.Assembler.AsmParserExtra
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Data.Attoparsec.Text
 
 parseAssemblyText :: MonadSafe m => Text -> m InstructionList
@@ -43,10 +44,10 @@ termWithoutPMExpressionParser :: Parser Expression
 termWithoutPMExpressionParser = makeExpressionWithoutPM <$> termParser
 
 termWithPMExpressionParser :: Parser Expression
-termWithPMExpressionParser = liftA2 (flip makeExpressionWithPM) termParser pmExpressionParser
+termWithPMExpressionParser = lift2 (flip makeExpressionWithPM) termParser pmExpressionParser
 
 pmExpressionParser :: Parser PMExpression
-pmExpressionParser = liftA2 PMExpression pmParser expressionParser
+pmExpressionParser = lift2 PMExpression pmParser expressionParser
 
 pmParser :: Parser PM
 pmParser = (Plus <$ char '+') <|> (Minus <$ char '-')

hs/src/HelVM/HelPA/Assemblers/Backend/ASQ/EsoLangs/Reducers/LabelReducer.hs

@@ -12,6 +12,7 @@ import           HelVM.HelIO.Containers.Extra
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Control.Type.Operator
 
 import qualified Data.Map                                                as Map
@@ -30,7 +31,7 @@ reduceForTEList :: MonadSafe m => LabelSymbols -> ExpressionList -> m Expression
 reduceForTEList addresses = traverse (reduceForTE addresses)
 
 reduceForTE :: MonadSafe m => LabelSymbols -> Expression -> m Expression
-reduceForTE addresses (Expression pm t) = liftA2 makeExpression pm' t' where
+reduceForTE addresses (Expression pm t) = lift2 makeExpression pm' t' where
   pm' = reduceForPmMaybe addresses pm
   t'  = reduceForTerm    addresses t
 

hs/src/HelVM/HelPA/Assemblers/Backend/ASQ/EsoLangs/Reducers/QuestionMarkReducer.hs

@@ -11,6 +11,7 @@ import           HelVM.HelPA.Assembler.Value
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Control.Type.Operator
 
 reduceQuestionMarks :: MonadSafe m => QuestionMark -> ExpressionList -> m ExpressionList
@@ -24,7 +25,7 @@ makeAddress CurrentAddress currentAddress = currentAddress
 makeAddress NextAddress    currentAddress = currentAddress + 1
 
 reduceForTE :: MonadSafe m => Symbol -> Expression -> m Expression
-reduceForTE address (Expression pm t) = liftA2 makeExpression pm' t' where
+reduceForTE address (Expression pm t) = lift2 makeExpression pm' t' where
   pm' = reduceForPmMaybe address pm
   t'  = reduceForTerm    address t
 

hs/src/HelVM/HelPA/Assemblers/Frontend/EIR/AsmParser.hs

@@ -6,6 +6,7 @@ import           HelVM.HelPA.Assembler.AsmParserExtra
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Control.Type.Operator
 import           Data.Attoparsec.Text
 import           Data.Char
@@ -100,7 +101,7 @@ integerValueAndIdentifierInstructionParser =
   <|> parser (L CLE) "le"
   <|> parser (L CGE) "ge"
     where
-      parser f t = liftA2 f d s where
+      parser f t = lift2 f d s where
         d = asciiCI t *> (skip1HorizontalSpace *> identifierParser)
         s = asciiCI "," *> skip1HorizontalSpace *> signedOptIntegerDotOptValueParser
 
@@ -113,18 +114,18 @@ integerValueAndNaturalValueAndIdentifierInstructionParser =
   <|> parser (J CLE) "jle"
   <|> parser (J CGE) "jge"
     where
-      parser f t = liftA3 f j d s where
+      parser f t = lift3 f j d s where
         j = asciiCI t *> (skip1HorizontalSpace *> dotOptIdentifierParser)
         d = asciiCI "," *> skip1HorizontalSpace *> identifierParser
         s = asciiCI "," *> skip1HorizontalSpace *> signedOptIntegerValueParser
 
 pFileInstructionParser :: Parser Instruction
-pFileInstructionParser = liftA2 PFile op1 op2 where
+pFileInstructionParser = lift2 PFile op1 op2 where
   op1 = asciiCI ".file" *> (skip1HorizontalSpace *> naturalParser)
   op2 = skip1HorizontalSpace *> textParser
 
 pLocInstructionParser :: Parser Instruction
-pLocInstructionParser = liftA3 PLoc op1 op2 op3 where
+pLocInstructionParser = lift3 PLoc op1 op2 op3 where
   op1 = asciiCI ".loc" *> (skip1HorizontalSpace *> naturalParser)
   op2 = skip1HorizontalSpace *> naturalParser
   op3 = skip1HorizontalSpace *> naturalParser

hs/src/HelVM/HelPA/Assemblers/Frontend/FBF/AsmParser.hs

@@ -7,6 +7,7 @@ import           HelVM.HelPA.Assembler.Value
 
 import           HelVM.HelIO.Control.Safe
 
+import           Control.Applicative.HT
 import           Control.Type.Operator
 import           Data.Attoparsec.Text
 import           Data.Char                                       hiding (Space)
@@ -73,13 +74,13 @@ lineBreaksParser :: Parser CompilerInstruction
 lineBreaksParser = LineBreaks <$> (asciiCI "#linebreaks" *> skipHorizontalSpace *> naturalParser)
 
 tableParser :: Parser CompilerInstruction
-tableParser = liftA2 (flip Table) (asciiCI "#table" *> skipHorizontalSpace *> identifierParser) (skipHorizontalSpace *> naturalParser)
+tableParser = lift2 (flip Table) (asciiCI "#table" *> skipHorizontalSpace *> identifierParser) (skipHorizontalSpace *> naturalParser)
 
 dimParser :: Parser CompilerInstruction
 dimParser = Dim <$> (asciiCI "#dim" *> skipHorizontalSpace *> identifiers1Parser)
 
 blockCompilerParser :: Parser CompilerInstruction
-blockCompilerParser = liftA2 block a b where
+blockCompilerParser = lift2 block a b where
   a = asciiCI "#block" *> skipHorizontalSpace *> identifierParser
   b = skipHorizontalSpace *> identifiersParser
 --  c = instructionListParser
@@ -121,31 +122,31 @@ identifier2CodeParser =
       parser Copy "copy"
   <|> parser CopySize "copysize"
   <|> parser Pop "pop"
-    where parser f t = liftA2 f (asciiCI t *> skip1HorizontalSpace *> identifierParser) (skip1HorizontalSpace *> identifierParser)
+    where parser f t = lift2 f (asciiCI t *> skip1HorizontalSpace *> identifierParser) (skip1HorizontalSpace *> identifierParser)
 
 integerValueIdentifierCodeParser :: Parser CodeInstruction
 integerValueIdentifierCodeParser =
       parser Push "push"
-    where parser f t = liftA2 f (asciiCI t *> skip1HorizontalSpace *> integerValueParser2) (skip1HorizontalSpace *> identifierParser)
+    where parser f t = lift2 f (asciiCI t *> skip1HorizontalSpace *> integerValueParser2) (skip1HorizontalSpace *> identifierParser)
 
 integerIdentifierCodeParser :: Parser CodeInstruction
 integerIdentifierCodeParser =
       parser Inc "inc"
   <|> parser Dec "dec"
   <|> parser Set "set"
     where
-      parser f t = liftA2 (flip f) (a t) b
+      parser f t = lift2 (flip f) (a t) b
       a t = asciiCI t *> skip1HorizontalSpace *> identifierParser
       b = skip1HorizontalSpace *> integerParser2
 
 rTableCodeParser :: Parser CodeInstruction
-rTableCodeParser = liftA3 (flip RTable) a b c where
+rTableCodeParser = lift3 (flip RTable) a b c where
   a = asciiCI "rtable" *> skip1HorizontalSpace *> identifierParser
   b = skip1HorizontalSpace *> integerValueParser2
   c = skip1HorizontalSpace *> identifierParser
 
 wTableCodeParser :: Parser CodeInstruction
-wTableCodeParser = liftA3 (flip3 WTable) a b c where
+wTableCodeParser = lift3 (flip3 WTable) a b c where
   a = asciiCI "wtable" *> skip1HorizontalSpace *> identifierParser
   b = skip1HorizontalSpace *> integerValueParser2
   c = skip1HorizontalSpace *> integerValueParser2
@@ -159,7 +160,7 @@ integerValue2IdentifierCodeParser =
   <|> parser Div "div"
   <|> parser Comp "comp"
     where
-      parser f t = liftA3 f (a t) b c
+      parser f t = lift3 f (a t) b c
       a t = asciiCI t *> skip1HorizontalSpace *> integerValueParser2
       b = skip1HorizontalSpace *> integerValueParser2
       c = skip1HorizontalSpace *> identifierParser
@@ -170,7 +171,7 @@ eqCodeParser =
   <|> parser IfEq "ifeq"
   <|> parser IfNotEq "ifnoteq"
     where
-      parser f t = liftA2 (flip (eqBlock f)) (a t) b
+      parser f t = lift2 (flip (eqBlock f)) (a t) b
       a t = asciiCI t *> skip1HorizontalSpace *> identifierParser
       b = skip1HorizontalSpace *> integerValueParser2
 --      c = instructionListParser
@@ -184,7 +185,7 @@ byte2AsciiCodeParser =
       parser Byte2Ascii "byte2ascii"
   <|> parser Byte2Ascii "BYTE2ASCII"
     where
-      parser f t = liftA4 f (a t) b c d
+      parser f t = lift4 f (a t) b c d
       a t = asciiCI t *> skip1HorizontalSpace *> integerValueParser2
       b = skip1HorizontalSpace *> identifierParser
       c = skip1HorizontalSpace *> identifierParser
@@ -195,7 +196,7 @@ ascii2ByteCodeParser =
       parser Ascii2Byte "ascii2byte"
   <|> parser Ascii2Byte "ASCII2BYTE"
     where
-      parser f t = liftA4 f (a t) b c d
+      parser f t = lift4 f (a t) b c d
       a t = asciiCI t *> skip1HorizontalSpace *> integerValueParser2
       b = skip1HorizontalSpace *> integerValueParser2
       c = skip1HorizontalSpace *> integerValueParser2
@@ -209,7 +210,7 @@ printParser = Print <$> (asciiCI "print" *> skipHorizontalSpace *> identifiers1P
 
 
 callParser :: Parser CodeInstruction
-callParser = liftA2 Call identifierParser (skipHorizontalSpace *> integerValuesParser)
+callParser = lift2 Call identifierParser (skipHorizontalSpace *> integerValuesParser)
 
 --
 
@@ -241,8 +242,3 @@ isEndWord c = isSpace c || (commentChar == c)
 
 commentChar :: Char
 commentChar = '-'
-
---
-
-liftA4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
-liftA4 func fa fb fc fd = func <$> fa <*> fb <*> fc <*> fd