From e68edae9a2b00e367f6088cb96dc3ca72c403da7 Mon Sep 17 00:00:00 2001
From: Michael Hueschen <m@mhueschen.dev>
Date: Mon, 26 Jun 2023 10:07:10 -0600
Subject: [PATCH] add other text modes & options parsing to choose them

---
 app/Main.hs | 97 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 uncap.cabal |  1 +
 2 files changed, 95 insertions(+), 3 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index b331272..1fd0c62 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,7 +1,98 @@
+{-# LANGUAGE LambdaCase #-}
+
 import Data.Char (toLower, toUpper)
+import Options.Applicative
+
+--------------------------------------------------------------------------------
+-- helpers
+--------------------------------------------------------------------------------
+
+perWord :: (String -> String) -> String -> String
+perWord f = unwords . map f . words
+
+perWordAcc :: ((String, a) -> (String, a)) -> a -> String -> String
+perWordAcc f acc = unwords . go f acc . words
+ where
+  go f acc     [] = []
+  go f acc (w:ws) = let (out, acc') = f (w, acc)
+                     in out : (go f acc' ws)
+
+sillyCase :: (String, Bool) -> (String, Bool)
+sillyCase ([]  , toCap) = ([]         , toCap)
+sillyCase (c:cs, toCap) = ((f c) : res, finalToCap)
+ where
+  (res, finalToCap) = sillyCase (cs, not toCap)
+  f = if toCap then toUpper else toLower
+
+--------------------------------------------------------------------------------
+-- main fns
+--------------------------------------------------------------------------------
+
+strToTitleCase :: String -> String
+strToTitleCase = perWord (\w -> toUpper (head w) : (map toLower (tail w)))
+
+strToLower :: String -> String
+strToLower = perWord (map toLower)
+
+strToUpper :: String -> String
+strToUpper = perWord (map toUpper)
+
+strToSillyCaseUpperFirst :: String -> String
+strToSillyCaseUpperFirst = perWordAcc sillyCase True
+
+strToSillyCaseLowerFirst :: String -> String
+strToSillyCaseLowerFirst = perWordAcc sillyCase False
+
+--------------------------------------------------------------------------------
+-- options parsing
+--------------------------------------------------------------------------------
+
+data Input
+  = ToTitle
+  | ToUpper
+  | ToLower
+  | ToSillyUpperFirst
+  | ToSillyLowerFirst
+
+input :: Parser Input
+input =
+  ( flag ToTitle ToTitle
+  (  short 't'
+  <> help "title case" ))
+  <|>
+  ( flag' ToUpper
+  (  short 'u'
+  <> help "upper case" ))
+  <|>
+  ( flag' ToLower
+  (  short 'l'
+  <> help "lower case" ))
+  <|>
+  ( flag' ToSillyUpperFirst
+  (  long "su"
+  <> help "silly, upper case first" ))
+  <|>
+  ( flag' ToSillyLowerFirst
+  (  long "sl"
+  <> help "silly, lower case first" ))
+
+opts = info (input <**> helper)
+         ( fullDesc
+        <> progDesc "uncap" )
+
+chooseF :: Input -> (String -> String)
+chooseF = \case
+  ToTitle -> strToTitleCase
+  ToLower -> strToLower
+  ToUpper -> strToUpper
+  ToSillyUpperFirst -> strToSillyCaseUpperFirst
+  ToSillyLowerFirst -> strToSillyCaseLowerFirst
 
-uncap :: String -> String
-uncap = unwords . map (\w -> toUpper (head w) : (map toLower (tail w))) . words
+--------------------------------------------------------------------------------
+-- main
+--------------------------------------------------------------------------------
 
 main :: IO ()
-main = interact uncap
+main = do
+  f <- chooseF <$> execParser opts
+  interact f
diff --git a/uncap.cabal b/uncap.cabal
index b87e6c4..93e7625 100644
--- a/uncap.cabal
+++ b/uncap.cabal
@@ -13,5 +13,6 @@ extra-source-files:  CHANGELOG.md, README.adoc
 executable uncap
   main-is:             Main.hs
   build-depends:       base ^>=4.17.0.0
+                     , optparse-applicative
   hs-source-dirs:      app
   default-language:    Haskell2010
-- 
2.45.2