~singpolyma/cheogram

2a39302a270b2b2195978f45a15a9d8fe3fdad0d — Stephen Paul Weber 8 days ago 16f3280
If command name starts with an emoji, display at the front of the line

Makes all the leading emoji "icons" line up with each other which is more
visually pleasing when they are present.
3 files changed, 62 insertions(+), 5 deletions(-)

M Adhoc.hs
M cheogram.cabal
M guix.scm
M Adhoc.hs => Adhoc.hs +19 -5
@@ 4,7 4,7 @@ import Prelude ()
import BasicPrelude hiding (log)
import Control.Concurrent (myThreadId, killThread)
import Control.Concurrent.STM
import Control.Error (hush, ExceptT, runExceptT, throwE, justZ)
import Control.Error (hush, ExceptT, runExceptT, throwE, justZ, headZ)
import Data.XML.Types as XML (Element(..), Node(NodeContent, NodeElement), Content(ContentText), isNamed, elementText, elementChildren, attributeText)
import qualified Data.XML.Types as XML



@@ 17,6 17,7 @@ import qualified Data.Attoparsec.Text as Atto
import qualified Data.Bool.HT as HT
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.ICU as ICU
import qualified Data.UUID as UUID ( toString, toText )
import qualified Data.UUID.V1 as UUID ( nextUUID )
import qualified UnexceptionalIO.Trans ()


@@ 45,12 46,25 @@ mapNode name
	| name == s"jabber:iq:register" = s"register"
	| otherwise = name

isEmojiRegex :: ICU.Regex
isEmojiRegex = ICU.regex [] (s"(\\p{Emoji}.*\\p{Me})|\\p{Emoji_Presentation}|\65039")

oneBotHelp :: Element -> Text
oneBotHelp item
	| Just _ <- ICU.find isEmojiRegex nameFirstGrapheme =
		nameFirstGrapheme ++ s" " ++ command ++ s": " ++ T.stripStart (T.drop (T.length nameFirstGrapheme) name)
	| otherwise = command ++ s": " ++ name
	where
	command = maybe mempty mapNode (attributeText (s"node") item)
	nameFirstGrapheme = fromMaybe mempty $ fmap ICU.brkBreak $ headZ $
		ICU.breaks (ICU.breakCharacter ICU.Root) name
	name = fromMaybe mempty (attributeText (s"name") item)

botHelp :: Maybe Text -> IQ -> Maybe Message
botHelp header (IQ { iqTo = Just to, iqFrom = Just from, iqPayload = Just payload }) =
	Just $ mkSMS from to $ maybe mempty (++ s"\n") header ++ (s"Help:\n\t") ++ intercalate (s"\n\t") (map (\item ->
		maybe mempty mapNode (attributeText (s"node") item) ++ s": " ++
		fromMaybe mempty (attributeText (s"name") item)
	) items)
	Just $ mkSMS from to $
		maybe mempty (++ s"\n") header ++ (s"Help:\n\t") ++
		intercalate (s"\n\t") (map oneBotHelp items)
	where
	items = isNamed (s"{http://jabber.org/protocol/disco#items}item") =<< elementChildren payload
botHelp _ _ = Nothing

M cheogram.cabal => cheogram.cabal +1 -0
@@ 63,6 63,7 @@ executable cheogram
                stm >= 2.4,
                stm-delay,
                text,
                text-icu,
                time,
                uuid,
                unexceptionalio,

M guix.scm => guix.scm +42 -0
@@ 19,10 19,51 @@
  (gnu packages haskell-crypto)
  (gnu packages haskell-web)
  (gnu packages haskell-xyz)
  (gnu packages icu4c)
  (gnu packages pkg-config)
  (ice-9 rdelim)
  (ice-9 popen)
)

(define-public ghc-text-icu
  (package
    (name "ghc-text-icu")
    (version "0.8.0.2")
    (source (origin
              (method url-fetch)
              (uri (hackage-uri "text-icu" version))
              (sha256
               (base32
                "0frxrsj580ipgb3pdvw1msdz8d63j02vvrqhzjja3ixlq24am69d"))))
    (build-system haskell-build-system)
    (native-inputs (list ghc-hunit
                         ghc-quickcheck
                         ghc-random
                         ghc-test-framework
                         ghc-test-framework-hunit
                         ghc-test-framework-quickcheck2
                         pkg-config
                         icu4c))
    (home-page "https://github.com/haskell/text-icu")
    (synopsis "Bindings to the ICU library")
    (description
     "Haskell bindings to the International Components for Unicode (ICU) libraries.
These libraries provide robust and full-featured Unicode services on a wide
variety of platforms. .  Features include: . * Both pure and impure bindings, to
allow for fine control over efficiency and ease of use. . * Breaking of strings
on character, word, sentence, and line boundaries. . * Access to the Unicode
Character Database (UCD) of character metadata. . * String collation functions,
for locales where the conventions for lexicographic ordering differ from the
simple numeric ordering of character codes. . * Character set conversion
functions, allowing conversion between Unicode and over 220 character encodings.
. * Unicode normalization. (When implementations keep strings in a normalized
form, they can be assured that equivalent strings have a unique binary
representation.) . * Regular expression search and replace. . * Security checks
for visually confusable (spoofable) strings. . * Bidirectional Unicode algorithm
. * Calendar objects holding dates and times. . * Number and calendar
formatting.")
    (license license:bsd-3)))

(define-public ghc-juicypixels-blurhash
  (package
    (name "ghc-juicypixels-blurhash")


@@ 741,6 782,7 @@ both a library and a command-line tool to access the library.")
        ghc-safe
        ghc-sha
        ghc-stm-delay
        ghc-text-icu
        ghc-unexceptionalio-trans
        ghc-utility-ht
        ghc-uuid