{- |
Copyright: (c) 2017-2019 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Various helpful functions to work with 'Text'
-}

module Summoner.Text
       ( endLine
       , packageToModule
       , packageNameValid
       , moduleNameValid
       , intercalateMap
       , headToUpper
       , tconcatMap
       ) where

import qualified Data.Char as C
import qualified Data.Text as T


-- | Endline symbol to use with @neat-interpolation@.
endLine :: Text
endLine :: Text
endLine = "\n"

-- | Creates module name from the name of the package
-- Ex: @my-lovely-project@ — @MyLovelyProject@
packageToModule :: Text -> Text
packageToModule :: Text -> Text
packageToModule = (Text -> Text) -> [Text] -> Text
forall a. (a -> Text) -> [a] -> Text
tconcatMap Text -> Text
headToUpper ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn "-"

-- | Decides whether the given text is a valid package name. Spec is here:
-- https://www.haskell.org/cabal/users-guide/developing-packages.html#package-names-and-versions
packageNameValid :: Text -> Bool
packageNameValid :: Text -> Bool
packageNameValid = (Char -> Bool) -> Text -> Bool
T.all (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-' Bool -> Bool -> Bool
|| Char -> Bool
C.isAlphaNum Char
c)

{- | Validate module name. It should be in the following formatTriple

@
Part1[.PartN]
@
-}
moduleNameValid :: Text -> Bool
moduleNameValid :: Text -> Bool
moduleNameValid = (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Text -> Bool
isValidFragment ([Text] -> Bool) -> (Text -> [Text]) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
T.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.')
  where
    isValidFragment :: Text -> Bool
    isValidFragment :: Text -> Bool
isValidFragment s :: Text
s =
           Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= ""
        Bool -> Bool -> Bool
&& (Char -> Bool) -> Text -> Bool
T.all Char -> Bool
C.isAlphaNum Text
s
        Bool -> Bool -> Bool
&& Char -> Bool
C.isUpper (Text -> Char
T.head Text
s)

{- | Converts every element of list into 'Text' and then joins every element
into single 'Text' like 'T.intercalate'.
-}
intercalateMap :: Text -> (a -> Text) -> [a] -> Text
intercalateMap :: Text -> (a -> Text) -> [a] -> Text
intercalateMap between :: Text
between showT :: a -> Text
showT = Text -> [Text] -> Text
T.intercalate Text
between ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
showT

headToUpper :: Text -> Text
headToUpper :: Text -> Text
headToUpper t :: Text
t = case Text -> Maybe (Char, Text)
T.uncons Text
t of
    Nothing      -> ""
    Just (x :: Char
x, xs :: Text
xs) -> Char -> Text -> Text
T.cons (Char -> Char
C.toUpper Char
x) Text
xs

-- | Convert every element of a list into text, and squash the results
tconcatMap :: (a -> Text) -> [a] -> Text
tconcatMap :: (a -> Text) -> [a] -> Text
tconcatMap f :: a -> Text
f = [Text] -> Text
T.concat ([Text] -> Text) -> ([a] -> [Text]) -> [a] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> [a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map a -> Text
f