Infinite Type

infinite_type.hs

module RecursiveContents (getRecursiveContents, simpleFind, filterM, betterFind) where

import Data.Maybe (fromMaybe)
import           Control.Exception (SomeException, bracket, handle)
import           Control.Monad     (filterM, forM)
import           Data.Time         (UTCTime)
import           System.Directory  (Permissions, doesFileExist,
                                    getModificationTime, getPermissions,
                                    listDirectory)
import           System.FilePath   ((</>))
import           System.IO         (IOMode (..), hClose, hFileSize, openFile)

simpleFind :: (FilePath -> Bool) -> FilePath -> IO [FilePath]
simpleFind predicate filePath = do
  contents <- getRecursiveContents filePath
  return $ filter predicate contents

getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topDir = do
  contents <- listDirectory topDir
  paths <- forM contents $ \path -> do
    let filePath' = topDir </> path
    isFile <- doesFileExist filePath'
    if isFile
      then return [filePath']
      else getRecursiveContents filePath'
  return (concat paths)

-- type Predicate = FilePath -> Permissions -> Maybe Integer -> UTCTime -> Bool
type Predicate = InfoP Bool

-- The point of betterFind is that we keep the predicate pure, and use filterM
-- to perform a monadic action
betterFind :: Predicate -> FilePath -> IO [FilePath]
betterFind predicate filePath = do
  contents <- getRecursiveContents filePath
  filterM filterPred contents
  where filterPred fp = do
          permissions <- getPermissions fp
          size <- getSize fp
          modifiedAt <- getModificationTime fp
          return $ predicate fp permissions size modifiedAt

handleAny :: (SomeException -> IO a) -> IO a -> IO a
handleAny = handle

getSize :: FilePath -> IO (Maybe Integer)
getSize filePath = handleAny (const $ return Nothing) getFileSize
  where getFileSize = bracket (openFile filePath ReadMode) hClose (fmap Just . hFileSize)

{-
  Here, we are trying to define a function that returns one of its result types.

  Notice that we've parameterized InfoP so that we can specify different return types.
 -}
type InfoP a = FilePath -> Permissions -> Maybe Integer -> UTCTime -> a

pathP :: InfoP FilePath
pathP fp _ _ _ = fp

sizeP :: InfoP Integer
sizeP _ _ size _ = fromMaybe (-1) size

-- So this is very cool. InfoP is a function that that gets applied to all values that a predicate should care about, gives us back a value, and let's us compare that to another value.
-- InfoP Bool is a type synonym (conceptually) for Predicate. If we delete the
-- definition of Predicate, we can then do type Predicate = InfoP Bool
equalP :: (Eq a) => InfoP a -> a -> InfoP Bool
equalP f k = \w x y z -> f w x y z == k

-- This is our first taste of lifting - the process of taking a function and
-- transforming it into a function that operates in a diferent context.
liftP :: (a -> b -> c) -> InfoP a -> b -> InfoP c
liftP f ip b = \w x y z -> ip w x y z `f` b

simpleAndP :: InfoP Bool -> InfoP Bool -> InfoP Bool
simpleAndP ipOne ipTwo = \w x y z -> ipOne w x y z && ipTwo w x y z

-- liftP2 is more general than liftP; we can write the latter in terms of the
-- former
liftP2 :: (a -> b -> c) -> InfoP a -> InfoP b -> InfoP c
liftP2 f iPO iPT = \w x y z -> iPO w x y z `f` iPT w x y z

constP :: a -> InfoP a
constP a = \w x y z -> a

liftP' :: (a -> b -> c) -> InfoP a -> b -> InfoP c
liftP' q f k w x y z = liftP2 q undefined undefined