chatty 0.6.1.0 → 0.6.2.1

raw patch · 6 files changed

+234/−31 lines, 6 filesdep +textdep ~basedep ~processdep ~template-haskellPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: text

Dependency ranges changed: base, process, template-haskell

API changes (from Hackage documentation)

Files

• System/Chatty/Commands.hs +1/−1
• System/Chatty/Filesystem.hs +157/−4
• Text/Chatty/Expansion/Vars.hs +6/−5
• Text/Chatty/Interactor.hs +21/−15
• Text/Chatty/Interactor/Templates.hs +47/−3
• chatty.cabal +2/−3

@@ -55,7 +55,7 @@   mprint s  -- | Prints the given string, after expanding it.-echo :: (ChPrinter m,ChExpand m) => String => m ()+echo :: (ChPrinter m,ChExpand m) => String -> m () echo = mprintLn <=< expand  -- | Mode for 'wc'.

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ExistentialQuantification, ScopedTypeVariables #-} {-   This module is part of Chatty.   Copyleft (c) 2014 Marvin Cohrs@@ -22,10 +22,14 @@  module System.Chatty.Filesystem where +import Control.Arrow import Control.Monad import Control.Monad.State import Control.Monad.Identity import Data.Chatty.Atoms+import Data.List+import Data.Monoid+import qualified Data.Text.IO as T import Text.Chatty.Printer import Text.Chatty.Scanner @@ -36,21 +40,36 @@ data File m = File {     loadFun :: m (FSExec ()),     saveFun :: m (FSExec ()),-    closeFun :: m (),     leftBehind :: String,     rightPending :: String   }+newtype Path = MultiPath [PathSpec] deriving (Eq,Ord,Show)+data PathSpec = Path PathRoot [PathSeg] deriving (Eq,Ord,Show)+data PathRoot = Absolute | Relative deriving (Eq,Ord,Show)+data PathSeg = SelParent | SelChild String deriving (Eq,Ord,Show) type FileA m = Atom (File m) -class ChAtoms m => ChFilesystem m where-  fopen :: String -> m (FSExec (FileA m))+data Mountpoint m = forall a. Mount {+  subMounts :: [Mountpoint m],+  mstate :: Atom a,+  mpath :: Path,+  mopen :: Path -> (Atom a, Path) -> m (FSExec (FileA m))+  } +class Monad m => ChFilesystem m where+  fopen :: Path -> m (FSExec (FileA m))+  fpwd :: m Path+  fcd :: Path -> m ()+ class Monad m => CanLoad m n where   fload :: FileA n -> m (FSExec ())  class Monad m => CanSave m n where   fsave :: FileA n -> m (FSExec ()) +class Monad m => CanMount m n where+  fmount :: Mountpoint n -> m ()+ data FilePrinterT m a = FilePrinter { runFilePrinterT :: FileA m -> m a } data FileScannerT m a = FileScanner { runFileScannerT :: FileA m -> m a } @@ -93,3 +112,137 @@   mscanL = FileScanner $ liftM rightPending . getAtom   mscannable = FileScanner $ liftM (not . null . rightPending) . getAtom   mready = mscannable++newtype NullFsT m a = NullFs { runNullFsT :: Path -> [Mountpoint (NullFsT m)] -> m (a, Path, [Mountpoint (NullFsT m)]) }++instance Monad m => Monad (NullFsT m) where+  return a = NullFs $ \p ms -> return (a,p,ms)+  m >>= f = NullFs $ \p ms -> do (a,p',ms') <- runNullFsT m p ms; runNullFsT (f a) p' ms'++instance Functor f => Functor (NullFsT f) where+  fmap f a = NullFs $ \p ms -> fmap (\(a,p,ms) -> (f a,p,ms)) $ runNullFsT a p ms+  +instance MonadTrans NullFsT where+  lift m = NullFs $ \p ms -> do a <- m; return (a,p,ms)++instance MonadIO m => MonadIO (NullFsT m) where+  liftIO = lift . liftIO++instance Monad m => ChFilesystem (NullFsT m) where+  fpwd = NullFs $ \p ms -> return (p,p,ms)+  fopen p = do+    ap <- absPath p+    p' <- NullFs $ \wd ms -> do+      case filter (isPath . snd) $ map (\m -> (m,ap `cmpPath` mpath m)) ms of+        [] -> return (NotFound, wd, ms)+        (p:_) -> return (FSSucc p, wd, ms)+    case p' of+      FSSucc (Mount subs st pa op, p') -> op p' (st,pa)+      NotFound -> return NotFound+  fcd p = NullFs $ \_ ms -> return ((),p,ms)++instance Monad m => CanMount (NullFsT m) (NullFsT m) where+  fmount m = NullFs $ \p ms -> return ((),p,m:ms)++absPath :: ChFilesystem m => Path -> m Path+absPath (MultiPath ps) =+  liftM (MultiPath . concat) $+  forM ps $ \(Path r ps) -> case r of+    Absolute -> return [Path Absolute $ rempar ps]+    Relative -> do+      MultiPath wds <- fpwd+      return $ do+        Path Absolute wd <- wds+        return $ Path Absolute $ rempar (wd++ps)+  where+    rempar (SelChild _:SelParent:rem) = rempar rem+    rempar (a:rem) = a : rempar rem+    rempar [] = []++cmpPath' :: [PathSeg] -> [PathSeg] -> Maybe [PathSeg]+cmpPath' ps [] = Just ps+cmpPath' (SelChild a:as) (SelChild b:bs) | a == b = cmpPath' as bs+cmpPath' (SelParent:as) (SelParent:bs) = cmpPath' as bs+cmpPath' _ _ = Nothing++cmpPath :: Path -> Path -> Path+cmpPath (MultiPath as) (MultiPath bs) = MultiPath $ do+  Path Absolute a <- as+  Path Absolute b <- bs+  case a `cmpPath'` b of+    Nothing -> []+    Just p -> [Path Absolute p]++isPath :: Path -> Bool+isPath (MultiPath p) = not $ null p++path :: String -> Path+path [] = MultiPath []+path ps =+  let took s = takeWhile (/='/') s+      left s = case drop (length $ took s) s of+        [] -> []+        (_:cs) -> cs+      subparse [] = []+      subparse s = case (took s, left s) of+        ([], []) -> []+        ([], l) -> subparse l+        ("..", l) -> SelParent : subparse l+        (".", l) -> subparse l+        (t, l) -> SelChild t : subparse l+  in case head ps of+    '/' -> MultiPath [Path Absolute $ subparse $ tail ps]+    _ -> MultiPath [Path Relative $ subparse ps]++expandofs :: (ChAtoms m,ChFilesystem m) => m (Mountpoint m)+expandofs = do+  a <- newAtom+  putAtom a []+  return $ Mount [] a (MultiPath []) $ \(MultiPath p) (sta,pa) -> do+    fa <- newAtom+    let ld = do+               st <- getAtom sta+               case filter (\(MultiPath x,_) -> not $ null $ intersect x p) st of+                 [] -> putAtom fa (File ld sv "" "") >> return (FSSucc ())+                 (_,tx):_ -> putAtom fa (File ld sv "" tx) >> return (FSSucc ())+        sv = do+               st <- getAtom sta+               fi <- getAtom fa+               case filter (\(_,(MultiPath x,_)) -> not $ null $ intersect x p) $ zip [1..] st of+                 [] -> do+                   putAtom sta ((MultiPath p,reverse (leftBehind fi)++rightPending fi) : st)+                   return (FSSucc ())+                 (i,_):_ -> do+                   putAtom sta (take i st ++ [(MultiPath p,reverse (leftBehind fi)++rightPending fi)] ++ drop (i+1) st)+                   return (FSSucc ())+    putAtom fa $ File ld sv "" ""+    return $ FSSucc fa++printerfs :: (ChPrinter m,ChAtoms m,ChFilesystem m) => m (Mountpoint m)+printerfs = do+  a <- newAtom+  putAtom a ()+  return $ Mount [] a (MultiPath []) $ \p _ -> do+    fa <- newAtom+    let ld = return $ FSSucc ()+        sv = do+          fi <- getAtom fa+          mprint (reverse (leftBehind fi) ++ rightPending fi)+          return $ FSSucc ()+    putAtom fa $ File ld sv "" ""+    return $ FSSucc fa++mount :: (CanMount m m, ChAtoms m, ChFilesystem m) => m (Mountpoint m) -> Path -> m ()+mount mpf p = do+  mp <- mpf+  fmount mp{mpath=p}++withNullFs :: ChAtoms m => NullFsT m a -> m a+withNullFs m = do+  (a,_,_) <- runNullFsT m (path "/") []+  return a++withExpandoFs :: (ChAtoms m, ChAtoms (NullFsT m)) => NullFsT m a -> m a+withExpandoFs m = withNullFs $ do+  mount expandofs (path "/")+  m

@@ -27,8 +27,8 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Trans.Class-import System.Environment hiding (getEnv)-import System.Posix.Env (getEnv, setEnv)+import System.Environment --hiding (getEnv)+--import System.Posix.Env (getEnv, setEnv) import Text.Chatty.Expansion  -- | Some environment variable@@ -75,7 +75,7 @@ -- | Export this local environment. exportAll :: (Monad m,MonadIO m) => ExpanderT m () exportAll = Expander $ \vs -> do-  liftIO $ forM_ vs $ \(k,v) -> setEnv k (show v) True+  liftIO $ forM_ vs $ \(k,v) -> setEnv k (show v)   return ((),vs)  instance ChExpand IO where@@ -91,6 +91,7 @@ expandVars ('$':'{':ss) =   let nm = takeBrace 0 ss       rm = drop (length nm + 1) ss+      takeBrace :: Int -> String -> String       takeBrace 0 ('}':ss) = ""       takeBrace n ('}':ss) = '}' : takeBrace (n-1) ss       takeBrace n ('{':ss) = '{' : takeBrace (n+1) ss@@ -125,5 +126,5 @@   mputv k v = Expander $ \vs -> return ((),(k,v):filter ((/=k).fst) vs)  instance ChExpanderEnv IO where-  mgetv = fmap (\v -> case v of Nothing -> NotSet; Just v' -> Literal v') . getEnv-  mputv k v = setEnv k (show v) True+  mgetv = fmap Literal . getEnv+  mputv k v = setEnv k (show v)

@@ -1,4 +1,4 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, TemplateHaskell, FlexibleContexts, TypeSynonymInstances #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies, TemplateHaskell, FlexibleContexts, TypeSynonymInstances, UndecidableInstances #-}  {-   This module is part of Chatty.@@ -24,6 +24,8 @@ -- | Provides a bunch of derived instances for the various typeclasses. module Text.Chatty.Interactor where +import Data.Chatty.Atoms+import Data.Chatty.Counter import Text.Chatty.Printer import Text.Chatty.Scanner import Text.Chatty.Scanner.Buffered@@ -34,6 +36,7 @@ import Text.Chatty.Extended.HTML import Text.Chatty.Extended.ANSI import Text.Chatty.Channel.Printer+import System.Chatty.Filesystem import System.Chatty.Misc import Text.Chatty.Interactor.Templates import System.Chatty.Spawn@@ -44,20 +47,23 @@ import Control.Monad.Identity import System.IO -mkInteractor ''RecorderT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock-mkInteractor ''DeafT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock-mkInteractor ''OutRedirT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock-mkInteractor ''HandleCloserT mkScanner mkBufferedScanner mkPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''ExpanderT mkScanner mkBufferedScanner mkPrinter mkFinalizer mkSpawn mkRandom mkClock mkHistoryEnv mkDefCP-mkInteractor ''HereStringT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''QuietT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''InRedirT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''SpawnOverlayT mkPrinter mkExtendedPrinter mkScanner mkBufferedScanner mkExpander mkExpanderEnv mkHistoryEnv mkFinalizer mkRandom mkClock mkDefCP-mkInteractor ''HtmlPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''AnsiPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''NullExpanderT mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkSpawn mkRandom mkClock mkDefCP-mkInteractor ''HistoryT  mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkSpawn mkRandom mkClock mkExpanderEnv mkDefCP-mkInteractor ''ScannerBufferT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkFinalizer mkRandom mkClock mkDefCP mkSpawn+mkInteractor ''RecorderT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkCounter mkAtoms mkFilesys+mkInteractor ''DeafT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkCounter mkAtoms mkFilesys+mkInteractor ''OutRedirT mkScanner mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkCounter mkAtoms mkFilesys+mkInteractor ''HandleCloserT mkScanner mkBufferedScanner mkPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''ExpanderT mkScanner mkBufferedScanner mkPrinter mkFinalizer mkSpawn mkRandom mkClock mkHistoryEnv mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''HereStringT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''QuietT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''InRedirT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''SpawnOverlayT mkPrinter mkExtendedPrinter mkScanner mkBufferedScanner mkExpander mkExpanderEnv mkHistoryEnv mkFinalizer mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''HtmlPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''AnsiPrinterT mkScanner mkBufferedScanner mkExpanderEnv mkHistoryEnv mkFinalizer mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''NullExpanderT mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkSpawn mkRandom mkClock mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''HistoryT  mkScanner mkBufferedScanner mkPrinter mkExtendedPrinter mkFinalizer mkSpawn mkRandom mkClock mkExpanderEnv mkDefCP mkCounter mkAtoms mkFilesys+mkInteractor ''ScannerBufferT mkPrinter mkExtendedPrinter mkExpander mkExpanderEnv mkHistoryEnv mkFinalizer mkRandom mkClock mkDefCP mkSpawn mkCounter mkAtoms mkFilesys+mkInteractor ''NullFsT mkScanner mkPrinter mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkCounter mkAtoms mkDefCP mkExtendedPrinter+mkInteractor ''CounterT mkScanner mkPrinter mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkExtendedPrinter+mkInteractor ''AtomStoreT mkScanner mkPrinter mkBufferedScanner mkFinalizer mkExpander mkExpanderEnv mkHistoryEnv mkSpawn mkRandom mkClock mkDefCP mkExtendedPrinter mkInteractor ''IntArchiverT mkArchiver mkInteractor ''BoolArchiverT mkArchiver mkInteractor ''HandleArchiverT mkArchiver

@@ -22,8 +22,10 @@ -}  -- | Declares serveral templates for comfortable instance derivation-module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkExpanderEnv,mkHistoryEnv,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty,mkChannelPrinter,mkDefCP,mkArchiver,mkExtendedPrinter,mkBufferedScanner) where+module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkExpanderEnv,mkHistoryEnv,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty,mkChannelPrinter,mkDefCP,mkArchiver,mkExtendedPrinter,mkBufferedScanner,mkCounter,mkAtoms,mkFilesys) where +import Data.Chatty.Atoms+import Data.Chatty.Counter import Text.Chatty.Scanner import Text.Chatty.Scanner.Buffered import Text.Chatty.Printer@@ -34,6 +36,7 @@ import Text.Chatty.Channel.Printer import Text.Chatty.Channel.Broadcast import System.Chatty.Spawn+import System.Chatty.Filesystem import Text.Chatty.Extended.Printer import Control.Monad import Control.Monad.Trans@@ -180,13 +183,53 @@   |]              where sx = strToType s +-- | Automatically derives a ChCounter instance for you.+mkCounter :: Name -> Q [Dec]+mkCounter s = [d|+    instance ChCounter m => ChCounter ($sx m) where+      countOn = lift countOn+  |]+  where sx = strToType s++-- | Automatically derives a ChAtoms instance for you.+mkAtoms :: Name -> Q [Dec]+mkAtoms s = [d|+    instance ChAtoms m => ChAtoms ($sx m) where+      putAtom a v = lift $ putAtom a v+      getAtom = lift . getAtom+      dispAtom = lift . dispAtom+  |]+  where sx = strToType s++-- | Automatically derives instances for ChFilesystem, CanLoad, CanSave, CanMount.+mkFilesys :: Name -> Q [Dec]+mkFilesys s = [d|+    instance (ChAtoms ($sx m), ChFilesystem m) => ChFilesystem ($sx m) where+      fopen p = do+        res <- lift $ fopen p+        case res of+          NoPermission -> return NoPermission+          NotFound -> return NotFound+          FSSucc a -> liftM FSSucc $ funAtom a (\a -> File (lift $ loadFun a) (lift $ saveFun a) (leftBehind a) (rightPending a)) (\b a -> b{leftBehind=leftBehind a,rightPending=rightPending a})+      fpwd = lift fpwd+      fcd = lift . fcd+    instance CanLoad m n => CanLoad ($sx m) n where+      fload = lift . fload+    instance CanSave m n => CanSave ($sx m) n where+      fsave = lift . fsave+    instance CanMount m n => CanMount ($sx m) n where+      fmount = lift . fmount+  |]+  where sx = strToType s+                -- | Automatically derives all chatty typeclasses for you. mkChatty :: Name -> Q [Dec] mkChatty s = mkInteractor s   mkPrinter mkScanner mkFinalizer mkExpander   mkSpawn mkRandom mkClock mkExpanderEnv   mkHistoryEnv mkDefCP mkExtendedPrinter-  mkBufferedScanner+  mkBufferedScanner mkCounter mkAtoms+  mkFilesys --  mkDefBC  -- | Automatically derives all chatty typeclasses that are sensible for an ArchiverT.@@ -194,7 +237,8 @@ mkArchiver s = mkInteractor s   mkScanner mkExpander mkExpanderEnv   mkHistoryEnv mkFinalizer mkSpawn-  mkRandom mkClock+  mkRandom mkClock mkCounter mkAtoms+  mkFilesys  -- | Just a helper class for mkInteractor class InteractorMaker i where

@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.6.1.0+version:             0.6.2.1  -- A short (one-line) description of the package. synopsis:            Some monad transformers and typeclasses for abstraction of global dependencies.@@ -58,11 +58,10 @@   other-extensions:    ExistentialQuantification, RankNTypes, Rank2Types, FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, TemplateHaskell, QuasiQuotes, UndecidableInstances      -- Other library packages from which modules are imported.-  build-depends:       base >=4.6 && <4.7, transformers >=0.3 && <0.4, directory >=1.2 && <1.3, process >=1.1 && <1.2, mtl >=2.1 && <2.2, template-haskell >=2.8 && <2.9, setenv >= 0.1 && <0.2, unix >= 2.6 && < 2.8, random >= 1.0 && < 1.1, time >= 1.4 && < 1.5, ansi-terminal >= 0.6 && <0.8, chatty-utils >= 0.7.1 && <0.8+  build-depends:       base >=4.7 && <4.8, transformers >=0.3 && <0.4, directory >=1.2 && <1.3, process >=1.1 && <1.3, mtl >=2.1 && <2.2, template-haskell >=2.8 && <2.10, setenv >= 0.1 && <0.2, unix >= 2.6 && < 2.8, random >= 1.0 && < 1.1, time >= 1.4 && < 1.5, ansi-terminal >= 0.6 && <0.8, chatty-utils >= 0.7.1 && <0.8, text >=1.1 && <1.2      -- Directories containing source files.   -- hs-source-dirs:            -- Base language which the package is written in.   default-language:    Haskell2010-