    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE MultiParamTypeClasses #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeSynonymInstances #-}
    {-# LANGUAGE ExistentialQuantification #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Text.Shakespeare.I18N
    -- Copyright   :  2012 Michael Snoyman <michael@snoyman.com>, Jeremy Shaw
    -- License     :  BSD-style (see the LICENSE file in the distribution)
    --
    -- Maintainer  :  Michael Snoyman <michael@snoyman.com>
    -- Stability   :  experimental
    -- Portability :  portable
    --
    -- This module provides a type-based system for providing translations
    -- for text strings.
    --
    -- It is similar in purpose to gettext or Java message bundles.
    --
    -- The core idea is to create simple data type where each constructor
    -- represents a phrase, sentence, paragraph, etc. For example:
    --
    -- > data AppMessages = Hello | Goodbye
    --
    -- The 'RenderMessage' class is used to retrieve the appropriate
    -- translation for a message value:
    --
    -- > class RenderMessage master message where
    -- >   renderMessage :: master  -- ^ type that specifies which set of translations to use
    -- >                 -> [Lang]  -- ^ acceptable languages in descending order of preference
    -- >                 -> message -- ^ message to translate
    -- >                 -> Text
    --
    -- Defining the translation type and providing the 'RenderMessage'
    -- instance in Haskell is not very translator friendly. Instead,
    -- translations are generally provided in external translations
    -- files. Then the 'mkMessage' Template Haskell function is used to
    -- read the external translation files and automatically create the
    -- translation type and the @RenderMessage@ instance.
    --
    -- A full description of using this module to create translations for @Hamlet@ can be found here:
    --
    --  <http://www.yesodweb.com/book/internationalization>
    --
    -- A full description of using the module to create translations for @HSP@ can be found here:
    --
    --  <http://happstack.com/docs/crashcourse/Templates.html#hsp-i18n>
    --
    -- You can also adapt those instructions for use with other systems.
    module Text.Shakespeare.I18N
        ( mkMessage
        , mkMessageFor
        , mkMessageVariant
        , RenderMessage (..)
        , ToMessage (..)
        , SomeMessage (..)
        , Lang
        ) where

    import Language.Haskell.TH.Syntax
    import Control.Applicative ((<$>))
    import Control.Monad (filterM, forM)
    import Data.Text (Text, pack, unpack)
    import System.Directory
    import Data.Maybe (catMaybes)
    import Data.List (isSuffixOf, sortBy, foldl')
    import qualified Data.Map as Map
    import qualified Data.ByteString as S
    import Data.Text.Encoding (decodeUtf8)
    import Data.Char (isSpace, toLower, toUpper)
    import Data.Ord (comparing)
    import Text.Shakespeare.Base (Deref (..), Ident (..), parseHash, derefToExp)
    import Text.ParserCombinators.Parsec (parse, many, eof, many1, noneOf, (<|>))
    import Control.Arrow ((***))
    import Data.Monoid (mempty, mappend)
    import qualified Data.Text as T
    import Data.String (IsString (fromString))

    -- | 'ToMessage' is used to convert the value inside #{ } to 'Text'
    --
    -- The primary purpose of this class is to allow the value in #{ } to
    -- be a 'String' or 'Text' rather than forcing it to always be 'Text'.
    class ToMessage a where
        toMessage :: a -> Text
    instance ToMessage Text where
        toMessage :: Text -> Text
    toMessage = Text -> Text
    forall a. a -> a
    id
    instance ToMessage String where
        toMessage :: String -> Text
    toMessage = String -> Text
    Data.Text.pack

    -- | the 'RenderMessage' is used to provide translations for a message types
    --
    -- The 'master' argument exists so that it is possible to provide more
    -- than one set of translations for a 'message' type. This is useful
    -- if a library provides a default set of translations, but the user
    -- of the library wants to provide a different set of translations.
    class RenderMessage master message where
        renderMessage :: master  -- ^ type that specifies which set of translations to use
                      -> [Lang]  -- ^ acceptable languages in descending order of preference
                      -> message -- ^ message to translate
                      -> Text

    instance RenderMessage master Text where
        renderMessage :: master -> [Text] -> Text -> Text
    renderMessage _ _ = Text -> Text
    forall a. a -> a
    id

    -- | an RFC1766 / ISO 639-1 language code (eg, @fr@, @en-GB@, etc).
    type Lang = Text

    -- |generate translations from translation files
    --
    -- This function will:
    --
    --  1. look in the supplied subdirectory for files ending in @.msg@
    --
    --  2. generate a type based on the constructors found
    --
    --  3. create a 'RenderMessage' instance
    --
    mkMessage :: String   -- ^ base name to use for translation type
              -> FilePath -- ^ subdirectory which contains the translation files
              -> Lang     -- ^ default translation language
              -> Q [Dec]
    mkMessage :: String -> String -> Text -> Q [Dec]
    mkMessage dt :: String
    dt folder :: String
    folder lang :: Text
    lang =
        Bool
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Text
    -> Q [Dec]
    mkMessageCommon Bool
    True "Msg" "Message" String
    dt String
    dt String
    folder Text
    lang

    -- | create 'RenderMessage' instance for an existing data-type
    mkMessageFor :: String     -- ^ master translation data type
                 -> String     -- ^ existing type to add translations for
                 -> FilePath   -- ^ path to translation folder
                 -> Lang       -- ^ default language
                 -> Q [Dec]
    mkMessageFor :: String -> String -> String -> Text -> Q [Dec]
    mkMessageFor master :: String
    master dt :: String
    dt folder :: String
    folder lang :: Text
    lang = Bool
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Text
    -> Q [Dec]
    mkMessageCommon Bool
    False "" "" String
    master String
    dt String
    folder Text
    lang

    -- | create an additional set of translations for a type created by `mkMessage`
    mkMessageVariant :: String     -- ^ master translation data type
                     -> String     -- ^ existing type to add translations for
                     -> FilePath   -- ^ path to translation folder
                     -> Lang       -- ^ default language
                     -> Q [Dec]
    mkMessageVariant :: String -> String -> String -> Text -> Q [Dec]
    mkMessageVariant master :: String
    master dt :: String
    dt folder :: String
    folder lang :: Text
    lang = Bool
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Text
    -> Q [Dec]
    mkMessageCommon Bool
    False "Msg" "Message" String
    master String
    dt String
    folder Text
    lang

    -- |used by 'mkMessage' and 'mkMessageFor' to generate a 'RenderMessage' and possibly a message data type
    mkMessageCommon :: Bool      -- ^ generate a new datatype from the constructors found in the .msg files
                    -> String    -- ^ string to append to constructor names
                    -> String    -- ^ string to append to datatype name
                    -> String    -- ^ base name of master datatype
                    -> String    -- ^ base name of translation datatype
                    -> FilePath  -- ^ path to translation folder
                    -> Lang      -- ^ default lang
                    -> Q [Dec]
    mkMessageCommon :: Bool
    -> String
    -> String
    -> String
    -> String
    -> String
    -> Text
    -> Q [Dec]
    mkMessageCommon genType :: Bool
    genType prefix :: String
    prefix postfix :: String
    postfix master :: String
    master dt :: String
    dt folder :: String
    folder lang :: Text
    lang = do
        [String]
    files <- IO [String] -> Q [String]
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO [String] -> Q [String]) -> IO [String] -> Q [String]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [String]
    getDirectoryContents String
    folder
        let files' :: [String]
    files' = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [".", ".."]) [String]
    files
        (filess :: [[String]]
    filess, contents :: [(Text, [Def])]
    contents) <- IO ([[String]], [(Text, [Def])]) -> Q ([[String]], [(Text, [Def])])
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO ([[String]], [(Text, [Def])])
     -> Q ([[String]], [(Text, [Def])]))
    -> IO ([[String]], [(Text, [Def])])
    -> Q ([[String]], [(Text, [Def])])
    forall a b. (a -> b) -> a -> b
    $ ([Maybe ([String], (Text, [Def]))]
     -> ([[String]], [(Text, [Def])]))
    -> IO [Maybe ([String], (Text, [Def]))]
    -> IO ([[String]], [(Text, [Def])])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ([([String], (Text, [Def]))] -> ([[String]], [(Text, [Def])])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([([String], (Text, [Def]))] -> ([[String]], [(Text, [Def])]))
    -> ([Maybe ([String], (Text, [Def]))]
        -> [([String], (Text, [Def]))])
    -> [Maybe ([String], (Text, [Def]))]
    -> ([[String]], [(Text, [Def])])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Maybe ([String], (Text, [Def]))] -> [([String], (Text, [Def]))]
    forall a. [Maybe a] -> [a]
    catMaybes) (IO [Maybe ([String], (Text, [Def]))]
     -> IO ([[String]], [(Text, [Def])]))
    -> IO [Maybe ([String], (Text, [Def]))]
    -> IO ([[String]], [(Text, [Def])])
    forall a b. (a -> b) -> a -> b
    $ (String -> IO (Maybe ([String], (Text, [Def]))))
    -> [String] -> IO [Maybe ([String], (Text, [Def]))]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> String -> IO (Maybe ([String], (Text, [Def])))
    loadLang String
    folder) [String]
    files'
        (([String] -> Q ()) -> [[String]] -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_(([String] -> Q ()) -> [[String]] -> Q ())
    -> ((String -> Q ()) -> [String] -> Q ())
    -> (String -> Q ())
    -> [[String]]
    -> Q ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .(String -> Q ()) -> [String] -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_) String -> Q ()
    addDependentFile [[String]]
    filess
        let contents' :: [(Text, [Def])]
    contents' = Map Text [Def] -> [(Text, [Def])]
    forall k a. Map k a -> [(k, a)]
    Map.toList (Map Text [Def] -> [(Text, [Def])])
    -> Map Text [Def] -> [(Text, [Def])]
    forall a b. (a -> b) -> a -> b
    $ ([Def] -> [Def] -> [Def]) -> [(Text, [Def])] -> Map Text [Def]
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
    Map.fromListWith [Def] -> [Def] -> [Def]
    forall a. [a] -> [a] -> [a]
    (++) [(Text, [Def])]
    contents
        [SDef]
    sdef <-
            case Text -> [(Text, [Def])] -> Maybe [Def]
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Text
    lang [(Text, [Def])]
    contents' of
                Nothing -> String -> Q [SDef]
    forall a. HasCallStack => String -> a
    error (String -> Q [SDef]) -> String -> Q [SDef]
    forall a b. (a -> b) -> a -> b
    $ "Did not find main language file: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Text -> String
    unpack Text
    lang
                Just def :: [Def]
    def -> [Def] -> Q [SDef]
    toSDefs [Def]
    def
        ([Def] -> Q ()) -> [[Def]] -> Q ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ([SDef] -> [Def] -> Q ()
    checkDef [SDef]
    sdef) ([[Def]] -> Q ()) -> [[Def]] -> Q ()
    forall a b. (a -> b) -> a -> b
    $ ((Text, [Def]) -> [Def]) -> [(Text, [Def])] -> [[Def]]
    forall a b. (a -> b) -> [a] -> [b]
    map (Text, [Def]) -> [Def]
    forall a b. (a, b) -> b
    snd [(Text, [Def])]
    contents'
        let mname :: Name
    mname = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ String
    dt String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    postfix
        [Clause]
    c1 <- ([[Clause]] -> [Clause]) -> Q [[Clause]] -> Q [Clause]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [[Clause]] -> [Clause]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (Q [[Clause]] -> Q [Clause]) -> Q [[Clause]] -> Q [Clause]
    forall a b. (a -> b) -> a -> b
    $ ((Text, [Def]) -> Q [Clause]) -> [(Text, [Def])] -> Q [[Clause]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> String -> (Text, [Def]) -> Q [Clause]
    toClauses String
    prefix String
    dt) [(Text, [Def])]
    contents'
        [Clause]
    c2 <- (SDef -> Q Clause) -> [SDef] -> Q [Clause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> String -> SDef -> Q Clause
    sToClause String
    prefix String
    dt) [SDef]
    sdef
        Clause
    c3 <- Q Clause
    defClause
        [Dec] -> Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $
         ( if Bool
    genType
           then ((Cxt
    -> Name
    -> [TyVarBndr]
    -> Maybe Kind
    -> [Con]
    -> [DerivClause]
    -> Dec
    DataD [] Name
    mname [] Maybe Kind
    forall a. Maybe a
    Nothing ((SDef -> Con) -> [SDef] -> [Con]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> SDef -> Con
    toCon String
    dt) [SDef]
    sdef) []) Dec -> [Dec] -> [Dec]
    forall a. a -> [a] -> [a]
    :)
           else [Dec] -> [Dec]
    forall a. a -> a
    id)
            [ Cxt -> Kind -> [Dec] -> Dec
    instanceD
                []
                (Name -> Kind
    ConT ''RenderMessage Kind -> Kind -> Kind
    `AppT` (Name -> Kind
    ConT (Name -> Kind) -> Name -> Kind
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    master) Kind -> Kind -> Kind
    `AppT` Name -> Kind
    ConT Name
    mname)
                [ Name -> [Clause] -> Dec
    FunD (String -> Name
    mkName "renderMessage") ([Clause] -> Dec) -> [Clause] -> Dec
    forall a b. (a -> b) -> a -> b
    $ [Clause]
    c1 [Clause] -> [Clause] -> [Clause]
    forall a. [a] -> [a] -> [a]
    ++ [Clause]
    c2 [Clause] -> [Clause] -> [Clause]
    forall a. [a] -> [a] -> [a]
    ++ [Clause
    c3]
                ]
            ]

    toClauses :: String -> String -> (Lang, [Def]) -> Q [Clause]
    toClauses :: String -> String -> (Text, [Def]) -> Q [Clause]
    toClauses prefix :: String
    prefix dt :: String
    dt (lang :: Text
    lang, defs :: [Def]
    defs) =
        (Def -> Q Clause) -> [Def] -> Q [Clause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Def -> Q Clause
    go [Def]
    defs
      where
        go :: Def -> Q Clause
    go def :: Def
    def = do
            Name
    a <- String -> Q Name
    newName "lang"
            (pat :: Pat
    pat, bod :: Exp
    bod) <- String -> String -> [String] -> [Content] -> Q (Pat, Exp)
    mkBody String
    dt (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Def -> String
    constr Def
    def) (((String, Maybe String) -> String)
    -> [(String, Maybe String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Maybe String) -> String
    forall a b. (a, b) -> a
    fst ([(String, Maybe String)] -> [String])
    -> [(String, Maybe String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Def -> [(String, Maybe String)]
    vars Def
    def) (Def -> [Content]
    content Def
    def)
            Guard
    guard <- (Exp -> Guard) -> Q Exp -> Q Guard
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Exp -> Guard
    NormalG [|$(return $ VarE a) == pack $(lift $ unpack lang)|]
            Clause -> Q Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> Q Clause) -> Clause -> Q Clause
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Body -> [Dec] -> Clause
    Clause
                [Pat
    WildP, Name -> [Pat] -> Pat
    ConP (String -> Name
    mkName ":") [Name -> Pat
    VarP Name
    a, Pat
    WildP], Pat
    pat]
                ([(Guard, Exp)] -> Body
    GuardedB [(Guard
    guard, Exp
    bod)])
                []

    mkBody :: String -- ^ datatype
           -> String -- ^ constructor
           -> [String] -- ^ variable names
           -> [Content]
           -> Q (Pat, Exp)
    mkBody :: String -> String -> [String] -> [Content] -> Q (Pat, Exp)
    mkBody dt :: String
    dt cs :: String
    cs vs :: [String]
    vs ct :: [Content]
    ct = do
        [(String, Name)]
    vp <- (String -> Q (String, Name)) -> [String] -> Q [(String, Name)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM String -> Q (String, Name)
    forall (m :: * -> *). Monad m => String -> m (String, Name)
    go [String]
    vs
        let pat :: Pat
    pat = Name -> [FieldPat] -> Pat
    RecP (String -> Name
    mkName String
    cs) (((String, Name) -> FieldPat) -> [(String, Name)] -> [FieldPat]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Name
    varName String
    dt (String -> Name) -> (Name -> Pat) -> (String, Name) -> FieldPat
    forall (a :: * -> * -> *) b c b' c'.
    Arrow a =>
    a b c -> a b' c' -> a (b, b') (c, c')
    *** Name -> Pat
    VarP) [(String, Name)]
    vp)
        let ct' :: [Content]
    ct' = (Content -> Content) -> [Content] -> [Content]
    forall a b. (a -> b) -> [a] -> [b]
    map ([(String, Name)] -> Content -> Content
    fixVars [(String, Name)]
    vp) [Content]
    ct
        Exp
    pack' <- [|Data.Text.pack|]
        Exp
    tomsg <- [|toMessage|]
        let ct'' :: [Exp]
    ct'' = (Content -> Exp) -> [Content] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (Exp -> Exp -> Content -> Exp
    toH Exp
    pack' Exp
    tomsg) [Content]
    ct'
        Exp
    mapp <- [|mappend|]
        let app :: Exp -> Exp -> Exp
    app a :: Exp
    a b :: Exp
    b = Maybe Exp -> Exp -> Maybe Exp -> Exp
    InfixE (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    a) Exp
    mapp (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    b)
        Exp
    e <-
            case [Exp]
    ct'' of
                [] -> [|mempty|]
                [x :: Exp
    x] -> Exp -> Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    x
                (x :: Exp
    x:xs :: [Exp]
    xs) -> Exp -> Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' Exp -> Exp -> Exp
    app Exp
    x [Exp]
    xs
        (Pat, Exp) -> Q (Pat, Exp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Pat
    pat, Exp
    e)
      where
        toH :: Exp -> Exp -> Content -> Exp
    toH pack' :: Exp
    pack' _ (Raw s :: String
    s) = Exp
    pack' Exp -> Exp -> Exp
    `AppE` Exp -> Kind -> Exp
    SigE (Lit -> Exp
    LitE (String -> Lit
    StringL String
    s)) (Name -> Kind
    ConT ''String)
        toH _ tomsg :: Exp
    tomsg (Var d :: Deref
    d) = Exp
    tomsg Exp -> Exp -> Exp
    `AppE` Scope -> Deref -> Exp
    derefToExp [] Deref
    d
        go :: String -> m (String, Name)
    go x :: String
    x = do
            let y :: Name
    y = String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ '_' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    x
            (String, Name) -> m (String, Name)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    x, Name
    y)
        fixVars :: [(String, Name)] -> Content -> Content
    fixVars vp :: [(String, Name)]
    vp (Var d :: Deref
    d) = Deref -> Content
    Var (Deref -> Content) -> Deref -> Content
    forall a b. (a -> b) -> a -> b
    $ [(String, Name)] -> Deref -> Deref
    fixDeref [(String, Name)]
    vp Deref
    d
        fixVars _ (Raw s :: String
    s) = String -> Content
    Raw String
    s
        fixDeref :: [(String, Name)] -> Deref -> Deref
    fixDeref vp :: [(String, Name)]
    vp (DerefIdent (Ident i :: String
    i)) = Ident -> Deref
    DerefIdent (Ident -> Deref) -> Ident -> Deref
    forall a b. (a -> b) -> a -> b
    $ String -> Ident
    Ident (String -> Ident) -> String -> Ident
    forall a b. (a -> b) -> a -> b
    $ [(String, Name)] -> String -> String
    fixIdent [(String, Name)]
    vp String
    i
        fixDeref vp :: [(String, Name)]
    vp (DerefBranch a :: Deref
    a b :: Deref
    b) = Deref -> Deref -> Deref
    DerefBranch ([(String, Name)] -> Deref -> Deref
    fixDeref [(String, Name)]
    vp Deref
    a) ([(String, Name)] -> Deref -> Deref
    fixDeref [(String, Name)]
    vp Deref
    b)
        fixDeref _ d :: Deref
    d = Deref
    d
        fixIdent :: [(String, Name)] -> String -> String
    fixIdent vp :: [(String, Name)]
    vp i :: String
    i =
            case String -> [(String, Name)] -> Maybe Name
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    i [(String, Name)]
    vp of
                Nothing -> String
    i
                Just y :: Name
    y -> Name -> String
    nameBase Name
    y

    sToClause :: String -> String -> SDef -> Q Clause
    sToClause :: String -> String -> SDef -> Q Clause
    sToClause prefix :: String
    prefix dt :: String
    dt sdef :: SDef
    sdef = do
        (pat :: Pat
    pat, bod :: Exp
    bod) <- String -> String -> [String] -> [Content] -> Q (Pat, Exp)
    mkBody String
    dt (String
    prefix String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SDef -> String
    sconstr SDef
    sdef) (((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst ([(String, String)] -> [String]) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> a -> b
    $ SDef -> [(String, String)]
    svars SDef
    sdef) (SDef -> [Content]
    scontent SDef
    sdef)
        Clause -> Q Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> Q Clause) -> Clause -> Q Clause
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Body -> [Dec] -> Clause
    Clause
            [Pat
    WildP, Name -> [Pat] -> Pat
    ConP (String -> Name
    mkName "[]") [], Pat
    pat]
            (Exp -> Body
    NormalB Exp
    bod)
            []

    defClause :: Q Clause
    defClause :: Q Clause
    defClause = do
        Name
    a <- String -> Q Name
    newName "sub"
        Name
    c <- String -> Q Name
    newName "langs"
        Name
    d <- String -> Q Name
    newName "msg"
        Exp
    rm <- [|renderMessage|]
        Clause -> Q Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> Q Clause) -> Clause -> Q Clause
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Body -> [Dec] -> Clause
    Clause
            [Name -> Pat
    VarP Name
    a, Name -> [Pat] -> Pat
    ConP (String -> Name
    mkName ":") [Pat
    WildP, Name -> Pat
    VarP Name
    c], Name -> Pat
    VarP Name
    d]
            (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp
    rm Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    a Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    c Exp -> Exp -> Exp
    `AppE` Name -> Exp
    VarE Name
    d)
            []

    toCon :: String -> SDef -> Con
    toCon :: String -> SDef -> Con
    toCon dt :: String
    dt (SDef c :: String
    c vs :: [(String, String)]
    vs _) =
        Name -> [VarBangType] -> Con
    RecC (String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ "Msg" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    c) ([VarBangType] -> Con) -> [VarBangType] -> Con
    forall a b. (a -> b) -> a -> b
    $ ((String, String) -> VarBangType)
    -> [(String, String)] -> [VarBangType]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> VarBangType
    go [(String, String)]
    vs
      where
        go :: (String, String) -> VarBangType
    go (n :: String
    n, t :: String
    t) = (String -> String -> Name
    varName String
    dt String
    n, Bang
    notStrict, Name -> Kind
    ConT (Name -> Kind) -> Name -> Kind
    forall a b. (a -> b) -> a -> b
    $ String -> Name
    mkName String
    t)

    varName :: String -> String -> Name
    varName :: String -> String -> Name
    varName a :: String
    a y :: String
    y =
        String -> Name
    mkName (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String -> String
    lower String
    a, "Message", String -> String
    upper String
    y]
      where
        lower :: String -> String
    lower (x :: Char
    x:xs :: String
    xs) = Char -> Char
    toLower Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs
        lower [] = []
        upper :: String -> String
    upper (x :: Char
    x:xs :: String
    xs) = Char -> Char
    toUpper Char
    x Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    xs
        upper [] = []

    checkDef :: [SDef] -> [Def] -> Q ()
    checkDef :: [SDef] -> [Def] -> Q ()
    checkDef x :: [SDef]
    x y :: [Def]
    y =
        [SDef] -> [Def] -> Q ()
    forall (m :: * -> *). Monad m => [SDef] -> [Def] -> m ()
    go ((SDef -> SDef -> Ordering) -> [SDef] -> [SDef]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((SDef -> String) -> SDef -> SDef -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing SDef -> String
    sconstr) [SDef]
    x) ((Def -> Def -> Ordering) -> [Def] -> [Def]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((Def -> String) -> Def -> Def -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing Def -> String
    constr) [Def]
    y)
      where
        go :: [SDef] -> [Def] -> m ()
    go _ [] = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go [] (b :: Def
    b:_) = String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "Extra message constructor: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Def -> String
    constr Def
    b
        go (a :: SDef
    a:as :: [SDef]
    as) (b :: Def
    b:bs :: [Def]
    bs)
            | SDef -> String
    sconstr SDef
    a String -> String -> Bool
    forall a. Ord a => a -> a -> Bool
    < Def -> String
    constr Def
    b = [SDef] -> [Def] -> m ()
    go [SDef]
    as (Def
    bDef -> [Def] -> [Def]
    forall a. a -> [a] -> [a]
    :[Def]
    bs)
            | SDef -> String
    sconstr SDef
    a String -> String -> Bool
    forall a. Ord a => a -> a -> Bool
    > Def -> String
    constr Def
    b = String -> m ()
    forall a. HasCallStack => String -> a
    error (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "Extra message constructor: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Def -> String
    constr Def
    b
            | Bool
    otherwise = do
                [(String, String)] -> [(String, Maybe String)] -> m ()
    forall a a (m :: * -> *).
    (Eq a, Eq a, Monad m) =>
    [(a, a)] -> [(a, Maybe a)] -> m ()
    go' (SDef -> [(String, String)]
    svars SDef
    a) (Def -> [(String, Maybe String)]
    vars Def
    b)
                [SDef] -> [Def] -> m ()
    go [SDef]
    as [Def]
    bs
        go' :: [(a, a)] -> [(a, Maybe a)] -> m ()
    go' ((an :: a
    an, at :: a
    at):as :: [(a, a)]
    as) ((bn :: a
    bn, mbt :: Maybe a
    mbt):bs :: [(a, Maybe a)]
    bs)
            | a
    an a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    bn = String -> m ()
    forall a. HasCallStack => String -> a
    error "Mismatched variable names"
            | Bool
    otherwise =
                case Maybe a
    mbt of
                    Nothing -> [(a, a)] -> [(a, Maybe a)] -> m ()
    go' [(a, a)]
    as [(a, Maybe a)]
    bs
                    Just bt :: a
    bt
                        | a
    at a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    bt -> [(a, a)] -> [(a, Maybe a)] -> m ()
    go' [(a, a)]
    as [(a, Maybe a)]
    bs
                        | Bool
    otherwise -> String -> m ()
    forall a. HasCallStack => String -> a
    error "Mismatched variable types"
        go' [] [] = () -> m ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
        go' _ _ = String -> m ()
    forall a. HasCallStack => String -> a
    error "Mistmached variable count"

    toSDefs :: [Def] -> Q [SDef]
    toSDefs :: [Def] -> Q [SDef]
    toSDefs = (Def -> Q SDef) -> [Def] -> Q [SDef]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Def -> Q SDef
    toSDef

    toSDef :: Def -> Q SDef
    toSDef :: Def -> Q SDef
    toSDef d :: Def
    d = do
        [(String, String)]
    vars' <- ((String, Maybe String) -> Q (String, String))
    -> [(String, Maybe String)] -> Q [(String, String)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String, Maybe String) -> Q (String, String)
    go ([(String, Maybe String)] -> Q [(String, String)])
    -> [(String, Maybe String)] -> Q [(String, String)]
    forall a b. (a -> b) -> a -> b
    $ Def -> [(String, Maybe String)]
    vars Def
    d
        SDef -> Q SDef
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SDef -> Q SDef) -> SDef -> Q SDef
    forall a b. (a -> b) -> a -> b
    $ String -> [(String, String)] -> [Content] -> SDef
    SDef (Def -> String
    constr Def
    d) [(String, String)]
    vars' (Def -> [Content]
    content Def
    d)
      where
        go :: (String, Maybe String) -> Q (String, String)
    go (a :: String
    a, Just b :: String
    b) = (String, String) -> Q (String, String)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    a, String
    b)
        go (a :: String
    a, Nothing) = String -> Q (String, String)
    forall a. HasCallStack => String -> a
    error (String -> Q (String, String)) -> String -> Q (String, String)
    forall a b. (a -> b) -> a -> b
    $ "Main language missing type for " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (String, String) -> String
    forall a. Show a => a -> String
    show (Def -> String
    constr Def
    d, String
    a)

    data SDef = SDef
        { SDef -> String
    sconstr :: String
        , SDef -> [(String, String)]
    svars :: [(String, String)]
        , SDef -> [Content]
    scontent :: [Content]
        }

    data Def = Def
        { Def -> String
    constr :: String
        , Def -> [(String, Maybe String)]
    vars :: [(String, Maybe String)]
        , Def -> [Content]
    content :: [Content]
        }

    (</>) :: FilePath -> FilePath -> FilePath
    path :: String
    path </> :: String -> String -> String
    </> file :: String
    file = String
    path String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ '/' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    file

    loadLang :: FilePath -> FilePath -> IO (Maybe ([FilePath], (Lang, [Def])))
    loadLang :: String -> String -> IO (Maybe ([String], (Text, [Def])))
    loadLang folder :: String
    folder file :: String
    file = do
        let file' :: String
    file' = String
    folder String -> String -> String
    </> String
    file
        Bool
    isFile <- String -> IO Bool
    doesFileExist String
    file'
        if Bool
    isFile Bool -> Bool -> Bool
    && ".msg" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    file
            then do
                let lang :: Text
    lang = String -> Text
    pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop 4 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ String -> String
    forall a. [a] -> [a]
    reverse String
    file
                [Def]
    defs <- String -> IO [Def]
    loadLangFile String
    file'
                Maybe ([String], (Text, [Def]))
    -> IO (Maybe ([String], (Text, [Def])))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([String], (Text, [Def]))
     -> IO (Maybe ([String], (Text, [Def]))))
    -> Maybe ([String], (Text, [Def]))
    -> IO (Maybe ([String], (Text, [Def])))
    forall a b. (a -> b) -> a -> b
    $ ([String], (Text, [Def])) -> Maybe ([String], (Text, [Def]))
    forall a. a -> Maybe a
    Just ([String
    file'], (Text
    lang, [Def]
    defs))
            else do
                Bool
    isDir <- String -> IO Bool
    doesDirectoryExist String
    file'
                if Bool
    isDir
                    then do
                        let lang :: Text
    lang = String -> Text
    pack String
    file
                        (files :: [String]
    files, defs :: [[Def]]
    defs) <- [(String, [Def])] -> ([String], [[Def]])
    forall a b. [(a, b)] -> ([a], [b])
    unzip ([(String, [Def])] -> ([String], [[Def]]))
    -> IO [(String, [Def])] -> IO ([String], [[Def]])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [(String, [Def])]
    loadLangDir String
    file'
                        Maybe ([String], (Text, [Def]))
    -> IO (Maybe ([String], (Text, [Def])))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([String], (Text, [Def]))
     -> IO (Maybe ([String], (Text, [Def]))))
    -> Maybe ([String], (Text, [Def]))
    -> IO (Maybe ([String], (Text, [Def])))
    forall a b. (a -> b) -> a -> b
    $ ([String], (Text, [Def])) -> Maybe ([String], (Text, [Def]))
    forall a. a -> Maybe a
    Just ([String]
    files, (Text
    lang, [[Def]] -> [Def]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[Def]]
    defs))
                    else
                        Maybe ([String], (Text, [Def]))
    -> IO (Maybe ([String], (Text, [Def])))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ([String], (Text, [Def]))
    forall a. Maybe a
    Nothing

    loadLangDir :: FilePath -> IO [(FilePath, [Def])]
    loadLangDir :: String -> IO [(String, [Def])]
    loadLangDir folder :: String
    folder = do
        [String]
    paths <- (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    folder String -> String -> String
    </>) ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> [String] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [".", ".."]) ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [String]
    getDirectoryContents String
    folder
        [String]
    files <- (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    doesFileExist [String]
    paths
        [String]
    dirs  <- (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    doesDirectoryExist [String]
    paths
        [Maybe (String, [Def])]
    langFiles <-
            [String]
    -> (String -> IO (Maybe (String, [Def])))
    -> IO [Maybe (String, [Def])]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [String]
    files ((String -> IO (Maybe (String, [Def])))
     -> IO [Maybe (String, [Def])])
    -> (String -> IO (Maybe (String, [Def])))
    -> IO [Maybe (String, [Def])]
    forall a b. (a -> b) -> a -> b
    $ \file :: String
    file -> do
                if ".msg" String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` String
    file
                    then do
                      [Def]
    defs <- String -> IO [Def]
    loadLangFile String
    file
                      Maybe (String, [Def]) -> IO (Maybe (String, [Def]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (String, [Def]) -> IO (Maybe (String, [Def])))
    -> Maybe (String, [Def]) -> IO (Maybe (String, [Def]))
    forall a b. (a -> b) -> a -> b
    $ (String, [Def]) -> Maybe (String, [Def])
    forall a. a -> Maybe a
    Just (String
    file, [Def]
    defs)
                    else do
                      Maybe (String, [Def]) -> IO (Maybe (String, [Def]))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (String, [Def])
    forall a. Maybe a
    Nothing
        [[(String, [Def])]]
    langDirs <- (String -> IO [(String, [Def])])
    -> [String] -> IO [[(String, [Def])]]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM String -> IO [(String, [Def])]
    loadLangDir [String]
    dirs
        [(String, [Def])] -> IO [(String, [Def])]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([(String, [Def])] -> IO [(String, [Def])])
    -> [(String, [Def])] -> IO [(String, [Def])]
    forall a b. (a -> b) -> a -> b
    $ [Maybe (String, [Def])] -> [(String, [Def])]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe (String, [Def])]
    langFiles [(String, [Def])] -> [(String, [Def])] -> [(String, [Def])]
    forall a. [a] -> [a] -> [a]
    ++ [[(String, [Def])]] -> [(String, [Def])]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(String, [Def])]]
    langDirs

    loadLangFile :: FilePath -> IO [Def]
    loadLangFile :: String -> IO [Def]
    loadLangFile file :: String
    file = do
        ByteString
    bs <- String -> IO ByteString
    S.readFile String
    file
        let s :: String
    s = Text -> String
    unpack (Text -> String) -> Text -> String
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Text
    decodeUtf8 ByteString
    bs
        [Def]
    defs <- ([Maybe Def] -> [Def]) -> IO [Maybe Def] -> IO [Def]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Maybe Def] -> [Def]
    forall a. [Maybe a] -> [a]
    catMaybes (IO [Maybe Def] -> IO [Def]) -> IO [Maybe Def] -> IO [Def]
    forall a b. (a -> b) -> a -> b
    $ (String -> IO (Maybe Def)) -> [String] -> IO [Maybe Def]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (String -> IO (Maybe Def)
    parseDef (String -> IO (Maybe Def))
    -> (String -> String) -> String -> IO (Maybe Def)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> String
    T.unpack (Text -> String) -> (String -> Text) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Text -> Text
    T.strip (Text -> Text) -> (String -> Text) -> String -> Text
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack) ([String] -> IO [Maybe Def]) -> [String] -> IO [Maybe Def]
    forall a b. (a -> b) -> a -> b
    $ String -> [String]
    lines String
    s
        [Def] -> IO [Def]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Def]
    defs

    parseDef :: String -> IO (Maybe Def)
    parseDef :: String -> IO (Maybe Def)
    parseDef "" = Maybe Def -> IO (Maybe Def)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Def
    forall a. Maybe a
    Nothing
    parseDef ('#':_) = Maybe Def -> IO (Maybe Def)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Def
    forall a. Maybe a
    Nothing
    parseDef s :: String
    s =
        case String
    end of
            ':':end' :: String
    end' -> do
                [Content]
    content' <- ([Content] -> [Content]) -> IO [Content] -> IO [Content]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Content] -> [Content]
    compress (IO [Content] -> IO [Content]) -> IO [Content] -> IO [Content]
    forall a b. (a -> b) -> a -> b
    $ String -> IO [Content]
    parseContent (String -> IO [Content]) -> String -> IO [Content]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile Char -> Bool
    isSpace String
    end'
                case String -> [String]
    words String
    begin of
                    [] -> String -> IO (Maybe Def)
    forall a. HasCallStack => String -> a
    error (String -> IO (Maybe Def)) -> String -> IO (Maybe Def)
    forall a b. (a -> b) -> a -> b
    $ "Missing constructor: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
                    (w :: String
    w:ws :: [String]
    ws) -> Maybe Def -> IO (Maybe Def)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Def -> IO (Maybe Def)) -> Maybe Def -> IO (Maybe Def)
    forall a b. (a -> b) -> a -> b
    $ Def -> Maybe Def
    forall a. a -> Maybe a
    Just Def :: String -> [(String, Maybe String)] -> [Content] -> Def
    Def
                                { constr :: String
    constr = String
    w
                                , vars :: [(String, Maybe String)]
    vars = (String -> (String, Maybe String))
    -> [String] -> [(String, Maybe String)]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> (String, Maybe String)
    parseVar [String]
    ws
                                , content :: [Content]
    content = [Content]
    content'
                                }
            _ -> String -> IO (Maybe Def)
    forall a. HasCallStack => String -> a
    error (String -> IO (Maybe Def)) -> String -> IO (Maybe Def)
    forall a b. (a -> b) -> a -> b
    $ "Missing colon: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    s
      where
        (begin :: String
    begin, end :: String
    end) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == ':') String
    s

    data Content = Var Deref | Raw String

    compress :: [Content] -> [Content]
    compress :: [Content] -> [Content]
    compress [] = []
    compress (Raw a :: String
    a:Raw b :: String
    b:rest :: [Content]
    rest) = [Content] -> [Content]
    compress ([Content] -> [Content]) -> [Content] -> [Content]
    forall a b. (a -> b) -> a -> b
    $ String -> Content
    Raw (String
    a String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    b) Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content]
    rest
    compress (x :: Content
    x:y :: [Content]
    y) = Content
    x Content -> [Content] -> [Content]
    forall a. a -> [a] -> [a]
    : [Content] -> [Content]
    compress [Content]
    y

    parseContent :: String -> IO [Content]
    parseContent :: String -> IO [Content]
    parseContent s :: String
    s =
        (ParseError -> IO [Content])
    -> ([Content] -> IO [Content])
    -> Either ParseError [Content]
    -> IO [Content]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> IO [Content]
    forall a. HasCallStack => String -> a
    error (String -> IO [Content])
    -> (ParseError -> String) -> ParseError -> IO [Content]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ParseError -> String
    forall a. Show a => a -> String
    show) [Content] -> IO [Content]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either ParseError [Content] -> IO [Content])
    -> Either ParseError [Content] -> IO [Content]
    forall a b. (a -> b) -> a -> b
    $ Parsec String () [Content]
    -> String -> String -> Either ParseError [Content]
    forall s t a.
    Stream s Identity t =>
    Parsec s () a -> String -> s -> Either ParseError a
    parse Parsec String () [Content]
    forall u. ParsecT String u Identity [Content]
    go String
    s String
    s
      where
        go :: ParsecT String u Identity [Content]
    go = do
            [Content]
    x <- ParsecT String u Identity Content
    -> ParsecT String u Identity [Content]
    forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
    many ParsecT String u Identity Content
    forall u. ParsecT String u Identity Content
    go'
            ParsecT String u Identity ()
    forall s (m :: * -> *) t u.
    (Stream s m t, Show t) =>
    ParsecT s u m ()
    eof
            [Content] -> ParsecT String u Identity [Content]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Content]
    x
        go' :: ParsecT String u Identity Content
    go' = (String -> Content
    Raw (String -> Content)
    -> ParsecT String u Identity String
    -> ParsecT String u Identity Content
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` ParsecT String u Identity Char -> ParsecT String u Identity String
    forall s (m :: * -> *) t u a.
    Stream s m t =>
    ParsecT s u m a -> ParsecT s u m [a]
    many1 (String -> ParsecT String u Identity Char
    forall s (m :: * -> *) u.
    Stream s m Char =>
    String -> ParsecT s u m Char
    noneOf "#")) ParsecT String u Identity Content
    -> ParsecT String u Identity Content
    -> ParsecT String u Identity Content
    forall s u (m :: * -> *) a.
    ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
    <|> ((Either String Deref -> Content)
    -> ParsecT String u Identity (Either String Deref)
    -> ParsecT String u Identity Content
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((String -> Content)
    -> (Deref -> Content) -> Either String Deref -> Content
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> Content
    Raw Deref -> Content
    Var) ParsecT String u Identity (Either String Deref)
    forall a. UserParser a (Either String Deref)
    parseHash)

    parseVar :: String -> (String, Maybe String)
    parseVar :: String -> (String, Maybe String)
    parseVar s :: String
    s =
        case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == '@') String
    s of
            (x :: String
    x, '@':y :: String
    y) -> (String
    x, String -> Maybe String
    forall a. a -> Maybe a
    Just String
    y)
            _ -> (String
    s, Maybe String
    forall a. Maybe a
    Nothing)

    data SomeMessage master = forall msg. RenderMessage master msg => SomeMessage msg

    instance IsString (SomeMessage master) where
        fromString :: String -> SomeMessage master
    fromString = Text -> SomeMessage master
    forall master msg.
    RenderMessage master msg =>
    msg -> SomeMessage master
    SomeMessage (Text -> SomeMessage master)
    -> (String -> Text) -> String -> SomeMessage master
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Text
    T.pack

    instance master ~ master' => RenderMessage master (SomeMessage master') where
        renderMessage :: master -> [Text] -> SomeMessage master' -> Text
    renderMessage a :: master
    a b :: [Text]
    b (SomeMessage msg :: msg
    msg) = master -> [Text] -> msg -> Text
    forall master message.
    RenderMessage master message =>
    master -> [Text] -> message -> Text
    renderMessage master
    a [Text]
    b msg
    msg

    notStrict :: Bang
    notStrict :: Bang
    notStrict = SourceUnpackedness -> SourceStrictness -> Bang
    Bang SourceUnpackedness
    NoSourceUnpackedness SourceStrictness
    NoSourceStrictness

    instanceD :: Cxt -> Type -> [Dec] -> Dec
    instanceD :: Cxt -> Kind -> [Dec] -> Dec
    instanceD = Maybe Overlap -> Cxt -> Kind -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    Nothing