{-|
Module      : Headroom.FileType
Description : Logic for handlig supported file types
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

Module providing functions for working with the 'FileType', such as performing
detection based on the file extension, etc.
-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE TypeApplications  #-}
module Headroom.FileType
  ( configByFileType
  , fileTypeByExt
  , listExtensions
  )
where

import           Headroom.Types                 ( FileType(..)
                                                , HeaderConfig(..)
                                                , HeadersConfig(..)
                                                )
import           Headroom.Types.EnumExtra       ( EnumExtra(..) )
import           RIO
import qualified RIO.List                      as L



-- | Returns 'FileType' for given file extension (without dot), using configured
-- values from the 'HeadersConfig'.
fileTypeByExt :: HeadersConfig  -- ^ license headers configuration
              -> Text           -- ^ file extension (without dot)
              -> Maybe FileType -- ^ found 'FileType'
fileTypeByExt :: HeadersConfig -> Text -> Maybe FileType
fileTypeByExt config :: HeadersConfig
config ext :: Text
ext =
  (FileType -> Bool) -> [FileType] -> Maybe FileType
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Text
ext ([Text] -> Bool) -> (FileType -> [Text]) -> FileType -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeadersConfig -> FileType -> [Text]
listExtensions HeadersConfig
config) (EnumExtra FileType => [FileType]
forall a. EnumExtra a => [a]
allValues @FileType)


-- | Lists all recognized file extensions for given 'FileType', using configured
-- values from the 'HeadersConfig'.
listExtensions :: HeadersConfig -- ^ license headers configuration
               -> FileType      -- ^ 'FileType' for which to list extensions
               -> [Text]        -- ^ list of appropriate file extensions
listExtensions :: HeadersConfig -> FileType -> [Text]
listExtensions config :: HeadersConfig
config fileType :: FileType
fileType =
  HeaderConfig -> [Text]
hcFileExtensions (HeadersConfig -> FileType -> HeaderConfig
configByFileType HeadersConfig
config FileType
fileType)


-- | Returns the proper 'HeaderConfig' for the given 'FileType', selected
-- from the 'HeadersConfig'.
configByFileType :: HeadersConfig -- ^ license headers configuration
                 -> FileType      -- ^ selected 'FileType'
                 -> HeaderConfig  -- ^ appropriate 'HeaderConfig'
configByFileType :: HeadersConfig -> FileType -> HeaderConfig
configByFileType HeadersConfig {..} fileType :: FileType
fileType = case FileType
fileType of
  C       -> HeaderConfig
hscC
  CPP     -> HeaderConfig
hscCpp
  CSS     -> HeaderConfig
hscCss
  Haskell -> HeaderConfig
hscHaskell
  HTML    -> HeaderConfig
hscHtml
  Java    -> HeaderConfig
hscJava
  JS      -> HeaderConfig
hscJs
  Rust    -> HeaderConfig
hscRust
  Scala   -> HeaderConfig
hscScala
  Shell   -> HeaderConfig
hscShell