never executed always true always false

    1 {-# LANGUAGE TypeFamilies #-}
    2 module CommandLine.World where
    3 
    4 import Prelude ()
    5 import Relude hiding (getLine, putStr)
    6 
    7 
    8 data FileType
    9     = IsFile
   10     | IsDirectory
   11     | DoesNotExist
   12 
   13 
   14 class Monad m => World m where
   15     readUtf8File :: FilePath -> m Text
   16     readUtf8FileWithPath :: FilePath -> m (FilePath, Text)
   17     readUtf8FileWithPath filePath =
   18         (,) filePath <$> readUtf8File filePath
   19     writeUtf8File :: FilePath -> Text -> m ()
   20     writeUtf8FileNoOverwrite :: FilePath -> Text -> m ()
   21     writeUtf8FileNoOverwrite path content =
   22         do
   23             exists <- doesFileExist path
   24             case exists of
   25                 True ->
   26                     error "file exists and was not marked to be overwritten"
   27                 False ->
   28                     writeUtf8File path content
   29 
   30     doesFileExist :: FilePath -> m Bool
   31     doesDirectoryExist :: FilePath -> m Bool
   32     listDirectory :: FilePath -> m [FilePath]
   33     stat :: FilePath -> m FileType
   34     stat path =
   35         do
   36             isFile <- doesFileExist path
   37             isDirectory <- doesDirectoryExist path
   38             return $ case ( isFile, isDirectory ) of
   39                 ( True, _ ) -> IsFile
   40                 ( _, True ) -> IsDirectory
   41                 ( False, False ) -> DoesNotExist
   42 
   43     getProgName :: m Text
   44 
   45     getStdin :: m Text
   46     getLine :: m Text
   47     getYesOrNo :: m Bool
   48     getYesOrNo =
   49       do  flushStdout
   50           input <- getLine
   51           case input of
   52             "y" -> return True
   53             "n" -> return False
   54             _   -> putStr "Must type 'y' for yes or 'n' for no: " *> getYesOrNo
   55     putStr :: Text -> m ()
   56     putStrLn :: Text -> m ()
   57     writeStdout :: Text -> m ()
   58     flushStdout :: m ()
   59     putStrStderr :: Text -> m ()
   60     putStrLnStderr :: Text -> m()
   61 
   62     exitFailure :: m ()
   63     exitSuccess :: m ()