-----------------------------------------------------------------------------
-- |
-- Module      :  Static.Resources
-- Copyright   :  (c) Scrive 2012
-- License     :  BSD-style (see the LICENSE file in the distribution)
--
-- Maintainer  :  mariusz@scrive.com
-- Stability   :  development
-- Portability :  portable
--
-- All types used by this module.
--

module Static.Resources.Types (
                               -- * Types
                                 ResourceType(..)
                               , Resource(..)
                               , ResourceSet(..)
                               , ResourceSpec(..)
                               , ImportType(..)
                               , ResourceSetForImport(..)
                               , ResourceSetsForImport(..)
                               -- * Utils
                               , filterByType
                        ) where
                            
import Data.Data
import System.Time
                        
-- | All resources have to be typed
data ResourceType =
                    -- | CSS file
                    CSS
                    -- | LESS support. See <http://lesscss.org/>.
                    | LESS
                    -- | JavaScript file
                    | JS  
                    -- | Special JavaScript. System will not join this one with other scripts.
                    | JSX 
                     deriving (Show, Data, Typeable, Eq)
                     
-- | Resource is a file with a type.
data Resource = Resource {
                      rtype :: !ResourceType
                    , path ::  !FilePath
                        } deriving Show

-- | 'ResourceSet' is named list of resources.
data ResourceSet = ResourceSet {
                      name :: !String
                    , resources ::  ![Resource]
                    } deriving Show

                    
-- | 'ResourceSpec' is a list of 'ResourceSet' and list of files or directories that can be ignored by 'check' function.
data ResourceSpec = ResourceSpec {
                      sets :: ![ResourceSet]
                    , ignored ::  ![FilePath]
                    } deriving Show           


-- | Utils for getting specyfic parts of 'ResourceSet'
filterByType :: (ResourceType -> Bool) -> ResourceSet -> [Resource]
filterByType f = filter (\r -> f $ rtype r) . resources


-- | We can import resources for development (no joined, gziped or minified) or for production.               
data ImportType = Development | Production deriving Show

-- |  'ResourceSet' that is ready to be imported. It's all you need to generate import list for html.
data ResourceSetForImport = ResourceSetForImport {
                                  set      :: !ResourceSet  
                                , cssFiles :: ![FilePath]
                                , jsFiles  :: ![FilePath]
                                , lessFiles :: ![FilePath]
                            } deriving Show
                            
-- | Set of 'ResourceSetForImport'
data ResourceSetsForImport = ResourceSetsForImport {
                                  _sets :: [ResourceSetForImport]
                                , generationTime :: ClockTime
                             } deriving Show