Text.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

module Morley.Util.Text
  ( headToLower
  , surround
  , dquotes
  , stripFieldPrefix
  , dropPrefix
  , toCamel
  , Manip.toPascal
  , toSnake
  , toSpinal
  , lowerCaseCluster
  ) where

import Data.Char (isLower, isUpper, toLower)
import Data.Text qualified as T
import Data.Text.Manipulate qualified as Manip

-- | Leads first character of text to lower case.
--
-- For empty text this will throw an error.
headToLower :: HasCallStack => Text -> Text
headToLower txt = case T.uncons txt of
  Nothing -> error "Empty text"
  Just (c, cs) -> T.cons (toLower c) cs

surround :: Semigroup a => a -> a -> a -> a
surround pre post content = pre <> content <> post

dquotes :: (Semigroup a, IsString a) => a -> a
dquotes = surround "\"" "\""

-- | Drops the field name prefix from a field.
--
-- We assume a convention of the prefix always being non-uppercase, and the
-- first letter of the actual field name being uppercase.
dropPrefix :: Text -> Text
dropPrefix = T.dropWhile (not . isUpper)

-- | Transform text to @camelCase@.
--
-- If the text starts with a single uppercase letter, it is lowercased. If it
-- starts with a cluster of non-lowercase letters, all but the last in the
-- cluster are lowercased.
--
-- >>> toCamel "MyField"
-- "myField"
-- >>> toCamel "USPosition"
-- "usPosition"
-- >>> toCamel "FA2Config"
-- "fa2Config"
toCamel :: Text -> Text
toCamel = Manip.toCamel . lowerCaseCluster

-- | Transform text to @snake_case@.
--
-- Non-lowercase clusters starting with an uppercase letter are treated as
-- separate words, except the last letter in the cluster.
--
-- >>> toSnake "MyField"
-- "my_field"
-- >>> toSnake "USPosition"
-- "us_position"
-- >>> toSnake "FA2Config"
-- "fa2_config"
-- >>> toSnake "MyUSPosition"
-- "my_us_position"
-- >>> toSnake "MyFie123d"
-- "my_fie123d"
toSnake :: Text -> Text
toSnake = T.intercalate "_" . fmap (Manip.toSnake . lowerCaseCluster) . Manip.splitWords

-- | Transform text to @spinal-case@.
--
-- Non-lowercase clusters starting with an uppercase letter are treated as
-- separate words, except the last letter in the cluster.
--
-- >>> toSpinal "MyField"
-- "my-field"
-- >>> toSpinal "USPosition"
-- "us-position"
-- >>> toSpinal "FA2Config"
-- "fa2-config"
-- >>> toSpinal "MyUSPosition"
-- "my-us-position"
-- >>> toSpinal "MyFie123d"
-- "my-fie123d"
toSpinal :: Text -> Text
toSpinal = T.intercalate "-" . fmap (Manip.toSpinal . lowerCaseCluster) . Manip.splitWords

-- | If text starts with a cluster of non-lowercase letters, lowercase them except
-- the last one.
--
-- >>> lowerCaseCluster "USPosition"
-- "usPosition"
-- >>> lowerCaseCluster "Position"
-- "Position"
-- >>> lowerCaseCluster "FA2Config"
-- "fa2Config"
lowerCaseCluster :: Text -> Text
lowerCaseCluster x = fromMaybe x do
  (c1, xs) <- T.uncons x
  (c2, _) <- T.uncons xs
  if notLower c1 && notLower c2
  then do
    let (ucs, rest) = T.span notLower x
    (ucs', lastuc) <- T.unsnoc ucs
    Just $ T.map toLower ucs' <> T.cons lastuc rest
  else Nothing
  where
    notLower = not . isLower

-- | Cut fields prefixes which we use according to the style guide.
--
-- >>> stripFieldPrefix "cmMyField"
-- "myField"
stripFieldPrefix :: Text -> Text
stripFieldPrefix = toCamel . dropPrefix