    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE CPP #-}
    -- | Various utilities used in the scaffolded site.
    module Yesod.Default.Util
        ( addStaticContentExternal
        , globFile
        , globFilePackage
        , widgetFileNoReload
        , widgetFileReload
        , TemplateLanguage (..)
        , defaultTemplateLanguages
        , WidgetFileSettings
        , wfsLanguages
        , wfsHamletSettings
        ) where

    import qualified Data.ByteString.Lazy as L
    import Data.FileEmbed (makeRelativeToProject)
    import Data.Text (Text, pack, unpack)
    import Yesod.Core -- purposely using complete import so that Haddock will see addStaticContent
    import Control.Monad (when, unless)
    import Conduit
    import System.Directory (doesFileExist, createDirectoryIfMissing)
    import Language.Haskell.TH.Syntax hiding (makeRelativeToProject)
    import Text.Lucius (luciusFile, luciusFileReload)
    import Text.Julius (juliusFile, juliusFileReload)
    import Text.Cassius (cassiusFile, cassiusFileReload)
    import Text.Hamlet (HamletSettings, defaultHamletSettings)
    import Data.Maybe (catMaybes)
    import Data.Default.Class (Default (def))

    -- | An implementation of 'addStaticContent' which stores the contents in an
    -- external file. Files are created in the given static folder with names based
    -- on a hash of their content. This allows expiration dates to be set far in
    -- the future without worry of users receiving stale content.
    addStaticContentExternal
        :: (L.ByteString -> Either a L.ByteString) -- ^ javascript minifier
        -> (L.ByteString -> String) -- ^ hash function to determine file name
        -> FilePath -- ^ location of static directory. files will be placed within a "tmp" subfolder
        -> ([Text] -> Route master) -- ^ route constructor, taking a list of pieces
        -> Text -- ^ filename extension
        -> Text -- ^ mime type
        -> L.ByteString -- ^ file contents
        -> HandlerFor master (Maybe (Either Text (Route master, [(Text, Text)])))
    addStaticContentExternal :: forall a master.
    (ByteString -> Either a ByteString)
    -> (ByteString -> [Char])
    -> [Char]
    -> ([Text] -> Route master)
    -> Text
    -> Text
    -> ByteString
    -> HandlerFor
         master (Maybe (Either Text (Route master, [(Text, Text)])))
    addStaticContentExternal ByteString -> Either a ByteString
    minify ByteString -> [Char]
    hash [Char]
    staticDir [Text] -> Route master
    toRoute Text
    ext' Text
    _ ByteString
    content = do
        IO () -> HandlerFor master ()
    forall a. IO a -> HandlerFor master a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> HandlerFor master ()) -> IO () -> HandlerFor master ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> [Char] -> IO ()
    createDirectoryIfMissing Bool
    True [Char]
    statictmp
        Bool
    exists <- IO Bool -> HandlerFor master Bool
    forall a. IO a -> HandlerFor master a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> HandlerFor master Bool)
    -> IO Bool -> HandlerFor master Bool
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO Bool
    doesFileExist [Char]
    fn'
        Bool -> HandlerFor master () -> HandlerFor master ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    exists (HandlerFor master () -> HandlerFor master ())
    -> HandlerFor master () -> HandlerFor master ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    -> (ConduitM ByteString Void (HandlerFor master) ()
        -> HandlerFor master ())
    -> HandlerFor master ()
    forall (m :: * -> *) (n :: * -> *) o a.
    (MonadUnliftIO m, MonadIO n) =>
    [Char] -> (ConduitM ByteString o n () -> m a) -> m a
    withSinkFileCautious [Char]
    fn' ((ConduitM ByteString Void (HandlerFor master) ()
      -> HandlerFor master ())
     -> HandlerFor master ())
    -> (ConduitM ByteString Void (HandlerFor master) ()
        -> HandlerFor master ())
    -> HandlerFor master ()
    forall a b. (a -> b) -> a -> b
    $ \ConduitM ByteString Void (HandlerFor master) ()
    sink ->
            ConduitT () Void (HandlerFor master) () -> HandlerFor master ()
    forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
    runConduit (ConduitT () Void (HandlerFor master) () -> HandlerFor master ())
    -> ConduitT () Void (HandlerFor master) () -> HandlerFor master ()
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ConduitT () ByteString (HandlerFor master) ()
    forall (m :: * -> *) lazy strict i.
    (Monad m, LazySequence lazy strict) =>
    lazy -> ConduitT i strict m ()
    sourceLazy ByteString
    content' ConduitT () ByteString (HandlerFor master) ()
    -> ConduitM ByteString Void (HandlerFor master) ()
    -> ConduitT () Void (HandlerFor master) ()
    forall (m :: * -> *) a b c r.
    Monad m =>
    ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
    .| ConduitM ByteString Void (HandlerFor master) ()
    sink
        Maybe (Either Text (Route master, [(Text, Text)]))
    -> HandlerFor
         master (Maybe (Either Text (Route master, [(Text, Text)])))
    forall a. a -> HandlerFor master a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (Either Text (Route master, [(Text, Text)]))
     -> HandlerFor
          master (Maybe (Either Text (Route master, [(Text, Text)]))))
    -> Maybe (Either Text (Route master, [(Text, Text)]))
    -> HandlerFor
         master (Maybe (Either Text (Route master, [(Text, Text)])))
    forall a b. (a -> b) -> a -> b
    $ Either Text (Route master, [(Text, Text)])
    -> Maybe (Either Text (Route master, [(Text, Text)]))
    forall a. a -> Maybe a
    Just (Either Text (Route master, [(Text, Text)])
     -> Maybe (Either Text (Route master, [(Text, Text)])))
    -> Either Text (Route master, [(Text, Text)])
    -> Maybe (Either Text (Route master, [(Text, Text)]))
    forall a b. (a -> b) -> a -> b
    $ (Route master, [(Text, Text)])
    -> Either Text (Route master, [(Text, Text)])
    forall a b. b -> Either a b
    Right ([Text] -> Route master
    toRoute [Text
    "tmp", [Char] -> Text
    pack [Char]
    fn], [])
      where
        fn, statictmp, fn' :: FilePath
        -- by basing the hash off of the un-minified content, we avoid a costly
        -- minification if the file already exists
        fn :: [Char]
    fn = ByteString -> [Char]
    hash ByteString
    content [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Char
    '.' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    : Text -> [Char]
    unpack Text
    ext'
        statictmp :: [Char]
    statictmp = [Char]
    staticDir [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "/tmp/"
        fn' :: [Char]
    fn' = [Char]
    statictmp [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    fn

        content' :: L.ByteString
        content' :: ByteString
    content'
            | Text
    ext' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == Text
    "js" = (a -> ByteString)
    -> (ByteString -> ByteString) -> Either a ByteString -> ByteString
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (ByteString -> a -> ByteString
    forall a b. a -> b -> a
    const ByteString
    content) ByteString -> ByteString
    forall a. a -> a
    id (Either a ByteString -> ByteString)
    -> Either a ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Either a ByteString
    minify ByteString
    content
            | Bool
    otherwise = ByteString
    content

    -- | expects a file extension for each type, e.g: hamlet lucius julius
    globFile :: String -> String -> FilePath
    globFile :: [Char] -> [Char] -> [Char]
    globFile [Char]
    kind [Char]
    x = [Char]
    "templates/" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    x [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "." [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    kind

    -- | `globFile` but returned path is absolute and within the package the Q Exp is evaluated
    -- @since 1.6.1.0
    globFilePackage :: String -> String -> Q FilePath
    globFilePackage :: [Char] -> [Char] -> Q [Char]
    globFilePackage = ([Char] -> Q [Char]
    makeRelativeToProject ([Char] -> Q [Char]) -> ([Char] -> [Char]) -> [Char] -> Q [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) (([Char] -> [Char]) -> [Char] -> Q [Char])
    -> ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> Q [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Char] -> [Char] -> [Char]
    globFile

    data TemplateLanguage = TemplateLanguage
        { TemplateLanguage -> Bool
    tlRequiresToWidget :: Bool
        , TemplateLanguage -> [Char]
    tlExtension :: String
        , TemplateLanguage -> [Char] -> Q Exp
    tlNoReload :: FilePath -> Q Exp
        , TemplateLanguage -> [Char] -> Q Exp
    tlReload :: FilePath -> Q Exp
        }

    defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
    defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
    defaultTemplateLanguages HamletSettings
    hset =
        [ Bool
    -> [Char]
    -> ([Char] -> Q Exp)
    -> ([Char] -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    False [Char]
    "hamlet"  [Char] -> Q Exp
    whamletFile' [Char] -> Q Exp
    whamletFile'
        , Bool
    -> [Char]
    -> ([Char] -> Q Exp)
    -> ([Char] -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  [Char]
    "cassius" [Char] -> Q Exp
    cassiusFile  [Char] -> Q Exp
    cassiusFileReload
        , Bool
    -> [Char]
    -> ([Char] -> Q Exp)
    -> ([Char] -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  [Char]
    "julius"  [Char] -> Q Exp
    juliusFile   [Char] -> Q Exp
    juliusFileReload
        , Bool
    -> [Char]
    -> ([Char] -> Q Exp)
    -> ([Char] -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  [Char]
    "lucius"  [Char] -> Q Exp
    luciusFile   [Char] -> Q Exp
    luciusFileReload
        ]
      where
        whamletFile' :: [Char] -> Q Exp
    whamletFile' = HamletSettings -> [Char] -> Q Exp
    whamletFileWithSettings HamletSettings
    hset

    data WidgetFileSettings = WidgetFileSettings
        { WidgetFileSettings -> HamletSettings -> [TemplateLanguage]
    wfsLanguages :: HamletSettings -> [TemplateLanguage]
        , WidgetFileSettings -> HamletSettings
    wfsHamletSettings :: HamletSettings
        }

    instance Default WidgetFileSettings where
        def :: WidgetFileSettings
    def = (HamletSettings -> [TemplateLanguage])
    -> HamletSettings -> WidgetFileSettings
    WidgetFileSettings HamletSettings -> [TemplateLanguage]
    defaultTemplateLanguages HamletSettings
    defaultHamletSettings

    widgetFileNoReload :: WidgetFileSettings -> FilePath -> Q Exp
    widgetFileNoReload :: WidgetFileSettings -> [Char] -> Q Exp
    widgetFileNoReload WidgetFileSettings
    wfs [Char]
    x = [Char] -> [Char] -> Bool -> [TemplateLanguage] -> Q Exp
    combine [Char]
    "widgetFileNoReload" [Char]
    x Bool
    False ([TemplateLanguage] -> Q Exp) -> [TemplateLanguage] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ WidgetFileSettings -> HamletSettings -> [TemplateLanguage]
    wfsLanguages WidgetFileSettings
    wfs (HamletSettings -> [TemplateLanguage])
    -> HamletSettings -> [TemplateLanguage]
    forall a b. (a -> b) -> a -> b
    $ WidgetFileSettings -> HamletSettings
    wfsHamletSettings WidgetFileSettings
    wfs

    widgetFileReload :: WidgetFileSettings -> FilePath -> Q Exp
    widgetFileReload :: WidgetFileSettings -> [Char] -> Q Exp
    widgetFileReload WidgetFileSettings
    wfs [Char]
    x = [Char] -> [Char] -> Bool -> [TemplateLanguage] -> Q Exp
    combine [Char]
    "widgetFileReload" [Char]
    x Bool
    True ([TemplateLanguage] -> Q Exp) -> [TemplateLanguage] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ WidgetFileSettings -> HamletSettings -> [TemplateLanguage]
    wfsLanguages WidgetFileSettings
    wfs (HamletSettings -> [TemplateLanguage])
    -> HamletSettings -> [TemplateLanguage]
    forall a b. (a -> b) -> a -> b
    $ WidgetFileSettings -> HamletSettings
    wfsHamletSettings WidgetFileSettings
    wfs

    combine :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
    combine :: [Char] -> [Char] -> Bool -> [TemplateLanguage] -> Q Exp
    combine [Char]
    func [Char]
    file Bool
    isReload [TemplateLanguage]
    tls = do
        [Maybe Exp]
    mexps <- Q [Maybe Exp]
    qmexps
        case [Maybe Exp] -> [Exp]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Exp]
    mexps of
            [] -> [Char] -> Q Exp
    forall a. HasCallStack => [Char] -> a
    error ([Char] -> Q Exp) -> [Char] -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                [ [Char]
    "Called "
                , [Char]
    func
                , [Char]
    " on "
                , [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show [Char]
    file
                , [Char]
    ", but no templates were found."
                ]
    #if MIN_VERSION_template_haskell(2,17,0)
            [Exp]
    exps -> Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> Q Exp) -> Exp -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ Maybe ModName -> [Stmt] -> Exp
    DoE Maybe ModName
    forall a. Maybe a
    Nothing ([Stmt] -> Exp) -> [Stmt] -> Exp
    forall a b. (a -> b) -> a -> b
    $ (Exp -> Stmt) -> [Exp] -> [Stmt]
    forall a b. (a -> b) -> [a] -> [b]
    map Exp -> Stmt
    NoBindS [Exp]
    exps
    #else
            exps -> return $ DoE $ map NoBindS exps
    #endif
      where
        qmexps :: Q [Maybe Exp]
        qmexps :: Q [Maybe Exp]
    qmexps = (TemplateLanguage -> Q (Maybe Exp))
    -> [TemplateLanguage] -> Q [Maybe Exp]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM TemplateLanguage -> Q (Maybe Exp)
    go [TemplateLanguage]
    tls

        go :: TemplateLanguage -> Q (Maybe Exp)
        go :: TemplateLanguage -> Q (Maybe Exp)
    go TemplateLanguage
    tl = [Char] -> Bool -> [Char] -> ([Char] -> Q Exp) -> Q (Maybe Exp)
    whenExists [Char]
    file (TemplateLanguage -> Bool
    tlRequiresToWidget TemplateLanguage
    tl) (TemplateLanguage -> [Char]
    tlExtension TemplateLanguage
    tl) ((if Bool
    isReload then TemplateLanguage -> [Char] -> Q Exp
    tlReload else TemplateLanguage -> [Char] -> Q Exp
    tlNoReload) TemplateLanguage
    tl)

    whenExists :: String
               -> Bool -- ^ requires toWidget wrap
               -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
    whenExists :: [Char] -> Bool -> [Char] -> ([Char] -> Q Exp) -> Q (Maybe Exp)
    whenExists = Bool
    -> [Char] -> Bool -> [Char] -> ([Char] -> Q Exp) -> Q (Maybe Exp)
    warnUnlessExists Bool
    False

    warnUnlessExists :: Bool
                     -> String
                     -> Bool -- ^ requires toWidget wrap
                     -> String -> (FilePath -> Q Exp) -> Q (Maybe Exp)
    warnUnlessExists :: Bool
    -> [Char] -> Bool -> [Char] -> ([Char] -> Q Exp) -> Q (Maybe Exp)
    warnUnlessExists Bool
    shouldWarn [Char]
    x Bool
    wrap [Char]
    glob [Char] -> Q Exp
    f = do
        [Char]
    fn <- [Char] -> [Char] -> Q [Char]
    globFilePackage [Char]
    glob [Char]
    x
        Bool
    e <- IO Bool -> Q Bool
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO Bool -> Q Bool) -> IO Bool -> Q Bool
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO Bool
    doesFileExist [Char]
    fn
        Bool -> Q () -> Q ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    shouldWarn Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    e) (Q () -> Q ()) -> Q () -> Q ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Q ()
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO (IO () -> Q ()) -> IO () -> Q ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "widget file not found: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    fn
        if Bool
    e
            then do
                Exp
    ex <- [Char] -> Q Exp
    f [Char]
    fn
                if Bool
    wrap
                    then do
                        Exp
    tw <- [|toWidget|]
                        Maybe Exp -> Q (Maybe Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Exp -> Q (Maybe Exp)) -> Maybe Exp -> Q (Maybe Exp)
    forall a b. (a -> b) -> a -> b
    $ Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> Exp -> Maybe Exp
    forall a b. (a -> b) -> a -> b
    $ Exp
    tw Exp -> Exp -> Exp
    `AppE` Exp
    ex
                    else Maybe Exp -> Q (Maybe Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe Exp -> Q (Maybe Exp)) -> Maybe Exp -> Q (Maybe Exp)
    forall a b. (a -> b) -> a -> b
    $ Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just Exp
    ex
            else Maybe Exp -> Q (Maybe Exp)
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Exp
    forall a. Maybe a
    Nothing