{-# LANGUAGE OverloadedStrings #-}
module Data.Text.Fillit.Internal
    ( Template
    , Dict
    , Config(..)
    , def
    , parseTemplate
    , combine
    , parseOnly
    , between'
    , Kind(..)
    ) where

import Control.Monad (foldM)
import Data.Bifunctor
import Data.Default
import qualified Data.HashMap.Lazy as HM
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Text.Parsec
import Text.Parsec.Text

type Template = Text
type Dict = HM.HashMap Text Text

data Config = Config
    { reqFrom :: String
    , reqTo   :: String
    , optFrom :: String
    , optTo   :: String
    }

instance Default Config where
    def = Config { reqFrom = "$"
                 , reqTo   = "$"
                 , optFrom = "%"
                 , optTo   = "%"
                 }


parseTemplate :: Config -> Template -> Either String [Kind]
parseTemplate cfg = parseOnly tmpParser
    where
        tmpParser :: Parser [Kind]
        tmpParser = many1 $ reqParser cfg
                        <|> optParser cfg
                        <|> try (rawParser cfg)
                        <|> rawParser'

reqParser :: Config -> Parser Kind
reqParser cfg = Req <$> between' (reqFrom cfg) (reqTo cfg)

optParser :: Config -> Parser Kind
optParser cfg = Opt <$> between' (optFrom cfg) (optTo cfg)

rawParser :: Config -> Parser Kind
rawParser cfg = Raw . T.pack <$> manyTill anyChar (lookAhead $ string (reqFrom cfg) <|> string (optFrom cfg))

rawParser' :: Parser Kind
rawParser' = Raw . T.pack <$> many1 anyChar

combine :: Config -> Dict -> [Kind] -> Either String Text
combine cfg dic = foldM replace ""
    where
        wrap k = T.pack (optFrom cfg) <> k <> T.pack (optTo cfg)
        replace :: Text -> Kind -> Either String Text
        replace acc (Req k) = maybe (Left $ "There is no key in dict, such as " ++ T.unpack k) (Right . (acc <>)) $ HM.lookup k dic
        replace acc (Opt k) = Right . maybe (acc <> wrap k) (acc <>) $ HM.lookup k dic
        replace acc (Raw t) = Right $ acc <> t

data Kind = Raw Text
          | Req Text
          | Opt Text
          deriving (Show, Eq)

parseOnly :: Parser a -> Template -> Either String a
parseOnly p = bimap show id . parse p ""

between' :: String -> String -> Parser Text
between' f t = T.pack <$> between (string f) (string t) (many1 letter)