    {-# 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
    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 :: (ByteString -> Either a ByteString)
    -> (ByteString -> String)
    -> String
    -> ([Text] -> Route master)
    -> Text
    -> Text
    -> ByteString
    -> HandlerFor
         master (Maybe (Either Text (Route master, [(Text, Text)])))
    addStaticContentExternal minify :: ByteString -> Either a ByteString
    minify hash :: ByteString -> String
    hash staticDir :: String
    staticDir toRoute :: [Text] -> Route master
    toRoute ext' :: Text
    ext' _ content :: ByteString
    content = do
        IO () -> HandlerFor master ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> HandlerFor master ()) -> IO () -> HandlerFor master ()
    forall a b. (a -> b) -> a -> b
    $ Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    statictmp
        Bool
    exists <- IO Bool -> HandlerFor master Bool
    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
    $ String -> IO Bool
    doesFileExist String
    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
    $ String
    -> (ConduitM ByteString Void (HandlerFor master) ()
        -> HandlerFor master ())
    -> HandlerFor master ()
    forall (m :: * -> *) (n :: * -> *) o a.
    (MonadUnliftIO m, MonadIO n) =>
    String -> (ConduitM ByteString o n () -> m a) -> m a
    withSinkFileCautious String
    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
    $ \sink :: 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 =>
    ConduitM a b m () -> ConduitM b c m r -> ConduitM 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 (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 ["tmp", String -> Text
    pack String
    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 :: String
    fn = ByteString -> String
    hash ByteString
    content String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ '.' Char -> String -> String
    forall a. a -> [a] -> [a]
    : Text -> String
    unpack Text
    ext'
        statictmp :: String
    statictmp = String
    staticDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "/tmp/"
        fn' :: String
    fn' = String
    statictmp String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    fn

        content' :: L.ByteString
        content' :: ByteString
    content'
            | Text
    ext' Text -> Text -> Bool
    forall a. Eq a => a -> a -> Bool
    == "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 :: String -> String -> String
    globFile kind :: String
    kind x :: String
    x = "templates/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    x String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "." String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    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 :: String -> String -> Q String
    globFilePackage = (String -> Q String
    makeRelativeToProject (String -> Q String) -> (String -> String) -> String -> Q String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$>) ((String -> String) -> String -> Q String)
    -> (String -> String -> String) -> String -> String -> Q String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> String
    globFile

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

    defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
    defaultTemplateLanguages :: HamletSettings -> [TemplateLanguage]
    defaultTemplateLanguages hset :: HamletSettings
    hset =
        [ Bool
    -> String
    -> (String -> Q Exp)
    -> (String -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    False "hamlet"  String -> Q Exp
    whamletFile' String -> Q Exp
    whamletFile'
        , Bool
    -> String
    -> (String -> Q Exp)
    -> (String -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  "cassius" String -> Q Exp
    cassiusFile  String -> Q Exp
    cassiusFileReload
        , Bool
    -> String
    -> (String -> Q Exp)
    -> (String -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  "julius"  String -> Q Exp
    juliusFile   String -> Q Exp
    juliusFileReload
        , Bool
    -> String
    -> (String -> Q Exp)
    -> (String -> Q Exp)
    -> TemplateLanguage
    TemplateLanguage Bool
    True  "lucius"  String -> Q Exp
    luciusFile   String -> Q Exp
    luciusFileReload
        ]
      where
        whamletFile' :: String -> Q Exp
    whamletFile' = HamletSettings -> String -> 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 -> String -> Q Exp
    widgetFileNoReload wfs :: WidgetFileSettings
    wfs x :: String
    x = String -> String -> Bool -> [TemplateLanguage] -> Q Exp
    combine "widgetFileNoReload" String
    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 -> String -> Q Exp
    widgetFileReload wfs :: WidgetFileSettings
    wfs x :: String
    x = String -> String -> Bool -> [TemplateLanguage] -> Q Exp
    combine "widgetFileReload" String
    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 :: String -> String -> Bool -> [TemplateLanguage] -> Q Exp
    combine func :: String
    func file :: String
    file isReload :: Bool
    isReload tls :: [TemplateLanguage]
    tls = do
        [Maybe Exp]
    mexps <- Q [Maybe Exp]
    qmexps
        case [Maybe Exp] -> [Exp]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe Exp]
    mexps of
            [] -> String -> Q Exp
    forall a. HasCallStack => String -> a
    error (String -> Q Exp) -> String -> Q Exp
    forall a b. (a -> b) -> a -> b
    $ [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                [ "Called "
                , String
    func
                , " on "
                , String -> String
    forall a. Show a => a -> String
    show String
    file
                , ", but no templates were found."
                ]
            exps :: [Exp]
    exps -> 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
    $ [Stmt] -> Exp
    DoE ([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
      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)
    mapM TemplateLanguage -> Q (Maybe Exp)
    go [TemplateLanguage]
    tls

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

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

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