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

This application can generate source code headers from templates for various
type of source code files. Such headers are usually represented as a top level
comment, the application must render such header with correct syntax.
The 'FileType' represents such type of source code file, which is recognized by
this application and for which the license headers can be manipulated.
-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Headroom.FileType
  ( FileType(..)
  , fileTypeByExt
  , listExtensions
  , fileTypeByName
  )
where

import           Headroom.Types.Utils           ( allValues
                                                , readEnumCI
                                                )
import           RIO
import qualified RIO.List                      as L
import qualified RIO.Text                      as T
import           Text.Read                      ( readsPrec )


-- | Represents supported type of source code file, where license headers may
-- be added, replaced or removed.
data FileType
  = CSS     -- ^ /CSS/ source code file
  | Haskell -- ^ /Haskell/ source code file
  | HTML    -- ^ /HTML/ source code file
  | Java    -- ^ /Java/ source code file
  | JS      -- ^ /JavaScript/ source code file
  | Scala   -- ^ /Scala/ source code file
  deriving (FileType
FileType -> FileType -> Bounded FileType
forall a. a -> a -> Bounded a
maxBound :: FileType
$cmaxBound :: FileType
minBound :: FileType
$cminBound :: FileType
Bounded, Int -> FileType
FileType -> Int
FileType -> [FileType]
FileType -> FileType
FileType -> FileType -> [FileType]
FileType -> FileType -> FileType -> [FileType]
(FileType -> FileType)
-> (FileType -> FileType)
-> (Int -> FileType)
-> (FileType -> Int)
-> (FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> FileType -> [FileType])
-> Enum FileType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
$cenumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
enumFromTo :: FileType -> FileType -> [FileType]
$cenumFromTo :: FileType -> FileType -> [FileType]
enumFromThen :: FileType -> FileType -> [FileType]
$cenumFromThen :: FileType -> FileType -> [FileType]
enumFrom :: FileType -> [FileType]
$cenumFrom :: FileType -> [FileType]
fromEnum :: FileType -> Int
$cfromEnum :: FileType -> Int
toEnum :: Int -> FileType
$ctoEnum :: Int -> FileType
pred :: FileType -> FileType
$cpred :: FileType -> FileType
succ :: FileType -> FileType
$csucc :: FileType -> FileType
Enum, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Eq FileType
Eq FileType =>
(FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c< :: FileType -> FileType -> Bool
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
$cp1Ord :: Eq FileType
Ord, Int -> FileType -> ShowS
[FileType] -> ShowS
FileType -> String
(Int -> FileType -> ShowS)
-> (FileType -> String) -> ([FileType] -> ShowS) -> Show FileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileType] -> ShowS
$cshowList :: [FileType] -> ShowS
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> ShowS
$cshowsPrec :: Int -> FileType -> ShowS
Show)

instance Read FileType where
  readsPrec :: Int -> ReadS FileType
readsPrec _ = ReadS FileType
forall a. (Bounded a, Enum a, Show a) => ReadS a
readEnumCI

-- | Returns 'FileType' for given file extension (without dot).
--
-- >>> fileTypeByExt "hs"
-- Just Haskell
fileTypeByExt :: Text           -- ^ file extension to search for
              -> Maybe FileType -- ^ corresponding 'FileType' (if found)
fileTypeByExt :: Text -> Maybe FileType
fileTypeByExt 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
. FileType -> [Text]
listExtensions) ([FileType]
forall a. (Bounded a, Enum a) => [a]
allValues :: [FileType])

-- | Lists all recognized file extensions for given 'FileType'.
--
-- >>> listExtensions Haskell
-- ["hs"]
listExtensions :: FileType -- ^ 'FileType' to list extensions for
               -> [Text]   -- ^ list of found file extensions
listExtensions :: FileType -> [Text]
listExtensions = \case
  CSS     -> ["css"]
  Haskell -> ["hs"]
  HTML    -> ["html", "htm"]
  Java    -> ["java"]
  JS      -> ["js"]
  Scala   -> ["scala"]

-- | Reads 'FileType' from its textual representation.
--
-- >>> fileTypeByName "haskell"
-- Just Haskell
fileTypeByName :: Text           -- ^ textual representation of 'FileType'
               -> Maybe FileType -- ^ corresponding 'FileType' (if found)
fileTypeByName :: Text -> Maybe FileType
fileTypeByName = String -> Maybe FileType
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe FileType)
-> (Text -> String) -> Text -> Maybe FileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack