module Plat.Template.Errors
(
 TemplateErr(..),
 TemplateErrLeft(..),
 TemplateErrRight(..),
 templateErr
) where
import Plat.Context
import Plat.Utils

-- | This is the part of an error message, which represents an erroneous opening
-- command.

data TemplateErrLeft =
    TryLeftTag | 

    -- ^ There is an error with the \'\@{\' command.

    LoopLeftTag

    -- ^ There is an error with the \'\@[\' command.

    deriving Eq

instance Show TemplateErrLeft where
    show TryLeftTag = "@{"
    show LoopLeftTag = "@["

-- | This is the part of an error message which represents an erroneous command,
-- which should follow some specific opening one.

data TemplateErrRight =
    TryRightTag |

    -- ^ There is an error with the \'\@}\' command.

    OrRightTag |

    -- ^ There is an error with the \'\@|\' command.

    LoopRightTag

    -- ^ There is an error with the \'\@]\' command.

    deriving Eq

instance Show TemplateErrRight where
    show TryRightTag = "@}"
    show OrRightTag = "@|"
    show LoopRightTag = "@]"

-- | This is a type of error messages you get when you're trying to compile
-- a syntactically incorrect template. It's quite possible that you'll want to
-- pattern-match on it, so it's internals are completely exposed, althoug it might
-- change in future versions. Note that we also provide a function 'templateErr',
-- which allows you to display errors with any formatting you like.

data TemplateErr =
    NoLeftTag TemplateErrRight Pos |

    -- ^ There is a command which should follow a specific opening command, like \'\@{\'
    -- or \'\@[\', but the latter could not be found.
    --
    -- For example, if your template is \'@foo\@|@\', then that's an error you'll get,
    -- as \'\@|\' command should be between \'\@{\' and \'\@}\'.

    NoRightTag TemplateErrLeft Pos |

    -- ^ There is an opening command without a matching closing one.

    MismatchedTags TemplateErrLeft Pos TemplateErrRight Pos

    -- ^ There is an opening command and a closing command, and they should match,
    -- but they don't.
    --
    -- If, for example, you close a branching, started by \'\@{\' command, with \'\@]\'
    -- command, you get this error.
    --
    -- There are two positions in this error message; the first is the position of the
    -- opening command, and the second is the position of the closing one.

instance Show TemplateErr where
    show (NoLeftTag er p) = "No opening tag for " ++ show er ++ " at " ++ show p
    show (NoRightTag er p) = "No closing tag for " ++ show er ++ " at " ++ show p
    show (MismatchedTags erl pl err pr) =
        "Mismatched tags: " ++ show erl ++ " at " ++ show pl ++
        " and " ++ show err ++ " at " ++ show pr
leftE :: TemplateErrLeft -> Pos -> Context ()
leftE t p =
    do "loop" =: (t == LoopLeftTag)
       "try" =: (t == TryLeftTag)
       "pos" =: posContext p
rightE :: TemplateErrRight -> Pos -> Context ()
rightE t p =
    do "loop" =: (t == LoopRightTag)
       "try" =: (t == TryRightTag)
       "or" =: (t == OrRightTag)
       "pos" =: posContext p

-- | If you want to present your error to the user for some reason, you can do this
-- with Plat itself. You'll need to create a template, as only you can know for sure
-- how this error message should be rendered, but the context is here. It gives you
-- \"left\" (respectively \"right\") field if there is the problem with the opening
-- (respectively closing or separating) command, which is also a record with
-- \"loop\", \"try\" and \"or\" boolean fields (the latter being absent in the
-- \"left\" record) whose values depend on the command in question, and a \"pos\" field
-- indicating the position of this command. It's possible to have both \"left\" and
-- \"right\" fields present, if there are an opening and closing commands that don't
-- match; obviously, in this case both \"left\" and \"right\" fields would have there
-- own \"pos\" subfields.
--
-- The position(s) is presented using the 'posContext' function.

templateErr :: TemplateErr -> Context ()
templateErr (NoLeftTag er p) = "right" =: rightE er p
templateErr (NoRightTag er p) = "left" =: leftE er p
templateErr (MismatchedTags erl sp err p) =
    do "left" =: leftE erl sp
       "right" =: rightE err p