{-# LANGUAGE OverloadedStrings #-} module Filesystem.CanonicalPath.Internal (CanonicalPath(..) ,canonicalPath ,canonicalPath' ,canonicalPathM ,canonicalPathM' ,canonicalPathE ,canonicalPathE' ,unsafePath ,Filesystem.CanonicalPath.Internal.readFile ,Filesystem.CanonicalPath.Internal.writeFile ,writeFile' ,Filesystem.CanonicalPath.Internal.appendFile ,preludeMap ,fromText ,toText ,toText' ,toPrelude ,fromPrelude ,voidM) where import BasicPrelude import Control.Applicative as Applicative import Control.Arrow (left, right) import Data.Text () import qualified Data.Text as Text import Filesystem.Path.CurrentOS import qualified Prelude import System.Directory (getHomeDirectory ,canonicalizePath) import qualified System.Environment as SE (getEnv) newtype CanonicalPath = CanonicalPath FilePath deriving Eq instance Show CanonicalPath where showsPrec d path = showParen (d > 15) (showString "CanonicalPath " . shows (toText' path)) {-| Unsafe constructor of 'CanonicalPath'. In case of any problems it will 'error'. Example: >>> canonicalPath "$HOME" CanonicalPath "/Users/your-user-name" >>> canonicalPath "unknown" *** Exception: Path does not exist (no such file or directory): unknown /Since 0.1.0.0/ -} canonicalPath :: MonadIO m => FilePath -> m CanonicalPath canonicalPath path = canonicalize path >>= either (error . textToString) (return . CanonicalPath) {-| Version of 'canonicalPath' that takes 'Data.Text' instead of 'Filesystem.Path.FilePath'. /Since 0.2.1.0/ -} canonicalPath' :: MonadIO m => Text -> m CanonicalPath canonicalPath' = canonicalPath . fromText {-| Constructs @'Maybe' 'CanonicalPath'@. >>> canonicalPathM "~" Just CanonicalPath "Users/your-user-name" >>> canonicalPathM "unknown" Nothing /Since 0.1.0.0/ -} canonicalPathM :: MonadIO m => FilePath -> m (Maybe CanonicalPath) canonicalPathM path = canonicalize path >>= either (\_ -> return Nothing) (return . Just . CanonicalPath) {-| Version of 'canonicalPathM' that takes 'Data.Text' instead of 'Filesystem.Path.FilePath'. /Since 0.2.1.0/ -} canonicalPathM' :: MonadIO m => Text -> m (Maybe CanonicalPath) canonicalPathM' = canonicalPathM . fromText {-| Constructs 'Prelude.Either' 'Data.Text' 'CanonicalPath'. >>> canonicalPathE "~/" Right CanonicalPath "/Users/your-user-name" >>> canonicalPathE "$HOME/this-folder-does-not-exist" Left "Path does not exist (no such file or directory): /Users/your-user-name/this-folder-does-not-exist" /Since 0.1.0.0/ -} canonicalPathE :: MonadIO m => FilePath -> m (Either Text CanonicalPath) canonicalPathE path = canonicalize path >>= either (return . Left) (return . Right . CanonicalPath) {-| Version of 'canonicalPathE' that takes 'Data.Text' instead of 'Filesystem.Path.FilePath'. /Since 0.2.1.0/ -} canonicalPathE' :: MonadIO m => Text -> m (Either Text CanonicalPath) canonicalPathE' = canonicalPathE . fromText -- | Convert 'CanonicalPath' to @Filesystem.FilePath@. -- -- /Since 0.1.0.0/ unsafePath :: CanonicalPath -> FilePath unsafePath (CanonicalPath up) = up -- * Functions used for canonicalization canonicalize :: MonadIO m => FilePath -> m (Either Text FilePath) canonicalize fp = extractPath fp >>= either (return . Left) canonicalize' -- we do want exceptions from canonicalizePath -- also canonicalizePath will throw exception -- when @path does not exist canonicalize' :: MonadIO m => Text -> m (Either Text FilePath) canonicalize' path = liftIO $ liftM (right fromPrelude) (tryIO . canonicalizePath . textToString $ path) extractPath :: MonadIO m => FilePath -> m (Either Text Text) extractPath = liftM (right concatPath . sequence) . mapM extractAtom . splitPath . toTextUnsafe . collapse extractAtom :: MonadIO m => Text -> m (Either Text Text) extractAtom atom = tryEnvPosix <||> tryHome <||> tryEnvWindows <%> atom -- * Parsers and parser combinators type Parser m = Text -> Maybe (m (Either Text Text)) tryEnvPosix :: MonadIO m => Parser m tryEnvPosix x = when' (Text.isPrefixOf "$" x) (Just . getEnv . Text.tail $ x) tryEnvWindows :: MonadIO m => Parser m tryEnvWindows x = when' (Text.isPrefixOf "%" x && Text.isSuffixOf "%" x) (Just . getEnv . Text.tail . Text.init $ x) tryHome :: MonadIO m => Parser m tryHome x = when' ("~" == x) (Just $ liftM Right homeDirectory) (<||>) :: MonadIO m => Parser m -> Parser m -> Parser m p1 <||> p2 = \v -> p1 v <|> p2 v (<%>) :: MonadIO m => Parser m -> Text -> m (Either Text Text) p <%> v = fromMaybe (return . Right $ v) (p v) -- * File operations -- | @readFile file@ function reads a /file/ and returns the contents of the /file/ as a 'Data.Text'. The /file/ is read lazily, on demand, as with getContents. -- -- /Since 0.1.1.0/ readFile :: MonadIO m => CanonicalPath -> m Text readFile = liftIO . BasicPrelude.readFile . unsafePath -- | @writeFile file txt@ writes /txt/ to the /file/. -- -- /Since 0.1.1.0/ writeFile :: MonadIO m => CanonicalPath -> Text -> m () writeFile p = liftIO . BasicPrelude.writeFile (unsafePath p) -- | @writeFile' dir file txt@ writes /txt/ to the /dir\/file/. Useful, when the file isn't created yet or you don't sure if it exists. -- -- /Since 0.1.2.0/ writeFile' :: MonadIO m => CanonicalPath -> FilePath -> Text -> m () writeFile' cp file = liftIO . BasicPrelude.writeFile (unsafePath cp file) -- | @appendFile file txt@ appends /txt/ to the /file/. -- -- /Since 0.1.1.0/ appendFile :: MonadIO m => CanonicalPath -> Text -> m () appendFile p = liftIO . BasicPrelude.appendFile (unsafePath p) -- * Utilities tryIO :: MonadIO m => IO a -> m (Either Text a) tryIO a = liftM (left show) (try' a) where try' :: MonadIO m => IO a -> m (Either IOException a) try' = liftIO . try getEnv :: MonadIO m => Text -> m (Either Text Text) getEnv = liftM (right fromString) . tryIO . SE.getEnv . textToString homeDirectory :: MonadIO m => m Text homeDirectory = liftIO $ fromString <$> getHomeDirectory when' :: Alternative f => Bool -> f a -> f a when' b v = if b then v else Applicative.empty splitPath :: Text -> [Text] splitPath = Text.splitOn "/" concatPath :: [Text] -> Text concatPath = Text.intercalate "/" -- concatPath :: [Either Text Text] -> Either Text Text -- concatPath = right BasicPrelude.concat . sequence -- concatPath = right (Text.intercalate "/") . sequence preludeMap :: (Prelude.FilePath -> a) -> CanonicalPath -> a preludeMap f = f . toPrelude . unsafePath -- | @toText path@ converts 'Filesystem.FilePath' /path/ to 'Data.Text'. In case of any problems it will throw error. -- -- See 'Filesystem.Path.CurrentOS.toText' function for details. -- -- /Since 0.3.0.0/ toTextUnsafe :: FilePath -> Text toTextUnsafe = either (error . textToString) id . toText -- | @toText' path@ converts 'CanonicalPath' to 'Data.Text'. -- -- /Since 0.3.0.0/ toText' :: CanonicalPath -> Text toText' = toTextUnsafe . unsafePath -- | @fromPrelude fp@ converts 'Prelude.FilePath' to 'Filesystem.Path.CurrentOS.toText'. -- -- /Since 0.1.0.0/ fromPrelude :: Prelude.FilePath -> FilePath fromPrelude = fromText . Text.pack -- | @toPrelude up@ converts 'Filesystem.Path.FilePath' to 'Prelude.FilePath'. -- -- /Since 0.1.0.0/ toPrelude :: FilePath -> Prelude.FilePath toPrelude = Text.unpack . toTextUnsafe voidM :: Monad m => m a -> m () voidM a = a >> return ()