aboutsummaryrefslogtreecommitdiff
path: root/src/server/Model/Message/Parts.hs
blob: d065cf26740604af3e548117e6df7423e4af08f5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
{-# LANGUAGE OverloadedStrings #-}

module Model.Message.Parts
  ( replaceParts
  , getParts
  ) where

import Data.Maybe (listToMaybe, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T

import Text.ParserCombinators.Parsec

import Model.Json.MessagePart

replaceParts :: [Text] -> Text -> Text
replaceParts values message =
  T.concat . map (replacePart values) $ getParts message

replacePart :: [Text] -> MessagePart -> Text
replacePart _ (Str str) = str
replacePart values (Order n) =
  fromMaybe (T.concat ["{", T.pack (show n), "}"]) . listToMaybe . drop (n - 1) $ values

getParts :: Text -> [MessagePart]
getParts str =
  case parse partsParser "" (T.unpack str) of
    Right parts -> parts
    Left _ -> []

partsParser :: Parser [MessagePart]
partsParser = many partParser

partParser :: Parser MessagePart
partParser =
  (do _ <- string "{"; n <- read <$> many1 digit; _ <- string "}"; return (Order n))
  <|> (do str <- T.pack <$> many1 (noneOf "{"); return (Str str))