Refactor modules WIP
authorCameron Ball <cameron@moodle.com>
Wed, 19 Jun 2019 03:37:28 +0000 (11:37 +0800)
committerCameron Ball <cameron@moodle.com>
Wed, 19 Jun 2019 03:37:28 +0000 (11:37 +0800)
package.yaml
src/Prompts.hs
src/Util.hs [new file with mode: 0644]
src/fuck.hs [deleted file]

index 71ad540..16347e0 100644 (file)
@@ -1,7 +1,7 @@
 name:                xyz
 version:             0.1.0.0
 license:             GPL-3
-author:              "Camerony Ball"
+author:              "Cameron Ball"
 maintainer:          "cameron@cameron1729.xyz"
 copyright:           "2019 Cameron Ball"
 
@@ -43,6 +43,10 @@ executables:
     dependencies:
     - xyz
 
+default-extensions:
+- OverloadedStrings
+- TupleSections
+
 tests:
   xyz-test:
     main:                Spec.hs
index ae8df00..e70fcd7 100644 (file)
@@ -1,22 +1,16 @@
-{-# LANGUAGE TupleSections #-}
+module Prompts (textPrompt, yornPrompt, dependantTextPrompt) where
 
-module Prompts
-    ( textPrompt, yornPrompt, dependantPrompt
-    ) where
-
-import System.IO
-import Data.Char (toLower)
+import Prelude hiding (getLine, null, putStrLn)
 import Control.Monad (join)
+import Data.Text (Text, append, toLower, null, pack)
+import Data.Text.IO (getLine, putStrLn)
 
-isEmpty :: String -> Bool
-isEmpty = (== "")
-
-cannotBeEmpty :: String -> Either String String
-cannotBeEmpty xs = case isEmpty xs of
+cannotBeEmpty :: Text -> Either Text Text
+cannotBeEmpty xs = case null xs of
   True -> Left "Value cannot be empty"
   False -> Right xs
 
-prompt :: String -> (String -> Either String a) -> IO a
+prompt :: Text -> (Text -> Either Text a) -> IO a
 prompt xs validate = do
   putStrLn xs
   response <- getLine
@@ -24,7 +18,7 @@ prompt xs validate = do
     Left error -> putStrLn error >> prompt xs validate
     Right result -> return result
 
-subPrompt :: String -> (String -> Bool) -> IO a -> IO (Maybe (String, a))
+subPrompt :: Text -> (Text -> Bool) -> IO a -> IO (Maybe (Text, a))
 subPrompt xs showNext p = do
   let v x = case showNext x of
         True -> Right $ p >>= return . Just . (x ,)
@@ -32,16 +26,16 @@ subPrompt xs showNext p = do
 
   join $ prompt xs v
 
-textPrompt :: String -> IO String
+textPrompt :: Text -> IO Text
 textPrompt xs = prompt xs cannotBeEmpty
 
-dependantPrompt :: String -> String -> IO (Maybe (String,String))
-dependantPrompt xs1 xs2 = subPrompt xs1 (not . isEmpty) $ prompt xs2 cannotBeEmpty
+dependantTextPrompt :: Text -> Text -> IO (Maybe (Text, Text))
+dependantTextPrompt xs1 xs2 = subPrompt xs1 (not . null) $ prompt xs2 cannotBeEmpty
 
-yornPrompt :: String -> IO Bool
+yornPrompt :: Text -> IO Bool
 yornPrompt xs = do
-  let v x = case (map toLower x) of
+  let v x = case (toLower x) of
                    "y" -> Right True
                    "n" -> Right False
                    _ -> Left "Please answer with y or n"
-  prompt (xs ++ " (y/n):") v
+  prompt (xs `append` " (y/n):") v
diff --git a/src/Util.hs b/src/Util.hs
new file mode 100644 (file)
index 0000000..5071998
--- /dev/null
@@ -0,0 +1,6 @@
+module Util where
+
+import Data.Text
+
+ununlines :: [Text] -> Text
+ununlines = intercalate "\n\n"
diff --git a/src/fuck.hs b/src/fuck.hs
deleted file mode 100644 (file)
index d24da53..0000000
+++ /dev/null
@@ -1,11 +0,0 @@
-import Data.Time.Clock
-import Data.Time.Clock.POSIX
-import Data.Time.Format
-import Data.Time.LocalTime
-
-a = posixSecondsToUTCTime 123456789
-
-tz = hoursToTimeZone 8
-
-timeStampToDateString :: UTCTime -> String
-timeStampToDateString time = formatTime defaultTimeLocale "%d %B %Y" (utcToLocalTime tz (time))