{-|
Module      : Headroom.Header
Description : License header manipulation
Copyright   : (c) 2019-2020 Vaclav Svejcar
License     : BSD-3
Maintainer  : vaclav.svejcar@gmail.com
Stability   : experimental
Portability : POSIX

License header is usually the very top comment in source code, holding some
short text about license type, author and copyright. This module provides data
types and functions for adding, dropping and replacing such headers. The license
header is represented by 'Header' data type, where 'FileType' defines for which
programming language source code this header is generated and the header text
itself.
-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Headroom.Header
  ( Header(..)
  , addHeader
  , containsHeader
  , dropHeader
  , headerSize
  , replaceHeader
  )
where

import           Headroom.FileType              ( FileType(..) )
import           Headroom.Header.Impl
import qualified Headroom.Text                 as T
import           Headroom.Types                 ( NewLine(..) )
import           RIO
import qualified RIO.List                      as L


-- | Generated license header for specified source code file type.
data Header = Header
  { Header -> FileType
hFileType :: FileType -- ^ type of the source code
  , Header -> Text
hContent  :: Text     -- ^ text of the header
  }
  deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)

-- | Adds header to the given source code text if no existing header is
-- detected, otherwise returns the unchanged input text. If you need to replace
-- the header, use the 'replaceHeader' instead.
addHeader :: Header -- ^ license header to add to the input text
          -> Text   -- ^ source code text
          -> Text   -- ^ source code text with added license header
addHeader :: Header -> Text -> Text
addHeader (Header fileType :: FileType
fileType content :: Text
content) input :: Text
input = Text
output
 where
  output :: Text
output = if Bool
containsHeader' then Text
input else Text
content Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
newLine Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
input
  containsHeader' :: Bool
containsHeader' = FileType -> Text -> Bool
containsHeader FileType
fileType Text
input
  newLine :: Text
newLine = NewLine -> Text
T.showNewLine (NewLine -> Text) -> NewLine -> Text
forall a b. (a -> b) -> a -> b
$ NewLine -> Maybe NewLine -> NewLine
forall a. a -> Maybe a -> a
fromMaybe NewLine
LF (Text -> Maybe NewLine
T.detectNewLine Text
input)

-- | Checks whether the license header is present in given source code text.
containsHeader :: FileType -- ^ type of the input source code text
               -> Text     -- ^ source code text
               -> Bool     -- ^ result of check
containsHeader :: FileType -> Text -> Bool
containsHeader fileType :: FileType
fileType input :: Text
input = FileType -> Text -> Int
headerSize FileType
fileType Text
input Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0

-- | Drops license header (if detected) from the given source code text.
dropHeader :: FileType  -- ^ type of the input source code text
           -> Text     -- ^ source code text
           -> Text     -- ^ source code text without the license header
dropHeader :: FileType -> Text -> Text
dropHeader fileType :: FileType
fileType input :: Text
input = NewLine -> [Text] -> Text
T.unlines' NewLine
newLine ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
L.drop Int
numLines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text]
lines'
 where
  numLines :: Int
numLines          = FileType -> Text -> Int
headerSize FileType
fileType Text
input
  (newLine :: NewLine
newLine, lines' :: [Text]
lines') = Text -> (NewLine, [Text])
T.lines' Text
input

-- | Detects what is the header size in terms of lines in the given source code
-- text. Returns @0@ if no header detected.
headerSize :: FileType -- ^ type of the input source code text
           -> Text     -- ^ source code text
           -> Int      -- ^ size of the headers (number of lines)
headerSize :: FileType -> Text -> Int
headerSize = \case
  CSS     -> Text -> Int
headerSizeCSS
  Haskell -> Text -> Int
headerSizeHaskell
  HTML    -> Text -> Int
headerSizeHTML
  Java    -> Text -> Int
headerSizeJava
  JS      -> Text -> Int
headerSizeJS
  Scala   -> Text -> Int
headerSizeScala

-- | Replaces already existing (or adds if none detected) license header with
-- the new one in the given source code text. If you need to only add header if
-- none detected and skip if it already contains one, use the 'addHeader'
-- instead.
replaceHeader :: Header -- ^ new license header to use for replacement
              -> Text   -- ^ source code text
              -> Text   -- ^ source code text with replaced license header
replaceHeader :: Header -> Text -> Text
replaceHeader h :: Header
h@(Header fileType :: FileType
fileType _) = Header -> Text -> Text
addHeader Header
h (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileType -> Text -> Text
dropHeader FileType
fileType