From 88a208e1523f9d953c70f95791fa7b0547b85fcc Mon Sep 17 00:00:00 2001 From: Cameron Ball Date: Wed, 19 Jun 2019 11:37:28 +0800 Subject: [PATCH] Refactor modules WIP --- package.yaml | 6 +++++- src/Prompts.hs | 34 ++++++++++++++-------------------- src/Util.hs | 6 ++++++ src/fuck.hs | 11 ----------- 4 files changed, 25 insertions(+), 32 deletions(-) create mode 100644 src/Util.hs delete mode 100644 src/fuck.hs diff --git a/package.yaml b/package.yaml index 71ad540..16347e0 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/src/Prompts.hs b/src/Prompts.hs index ae8df00..e70fcd7 100644 --- a/src/Prompts.hs +++ b/src/Prompts.hs @@ -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 index 0000000..5071998 --- /dev/null +++ b/src/Util.hs @@ -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 index d24da53..0000000 --- a/src/fuck.hs +++ /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)) -- 2.11.0