{-# LANGUAGE RankNTypes, ImplicitParams, LambdaCase #-}
module IO.Filesystem (
  -- * Exported modules
  module System.FilePath,module Definitive,

  -- * The File interface
  File(..),DirEntry(..),
  getFile,
  
  workingDirectory,
  Location(..),
  pathTo,getConfig,

  -- ** A useful monad for manipulating the filesystem as a state
  FS(..),Filesystem,file,
  
  -- ** Status
  modTime,
  
  -- ** Useful Lenses
  contents,children,child,descendant,subEntry,anyEntry,entryName,entryFile,
  named,withExtension,
  fileName,entry,text,bytes
  ) where

import Definitive
import Control.DeepSeq
import IO.Time
import System.Directory 
import System.FilePath ((</>),FilePath)
import System.IO.Unsafe
import System.Posix.Process (getProcessID)
import Data.Time.Clock.POSIX
import qualified Prelude as P

data File = File (Maybe String) (Maybe Bytes)
          | Directory (Map String File) 
instance Show File where
  show (File _ _) = "File"
  show (Directory d) = show d
instance Semigroup File where
  Directory d + Directory d' = Directory ((d*d')+(d+d'))
  a + _ = a
instance Monoid File where zero = File zero zero

data DirEntry = DirEntry FilePath File
              deriving Show
instance Lens1 String String DirEntry DirEntry where
  l'1 = from _DirEntry.l'1
instance Lens2 File File DirEntry DirEntry where
  l'2 = from _DirEntry.l'2
fileName :: Lens' DirEntry String
fileName = l'1
entry :: Lens' DirEntry File
entry = l'2

il :: IO a -> IO a
il = unsafeInterleaveIO
getFile :: FilePath -> IO File
getFile path = do
  d <- doesDirectoryExist path
  if d then do
    files <- unsafeInterleaveIO (getDirectoryContents path)
    return $ Directory $ fromList [
      (name,unsafePerformIO (getFile (path</>name)))
      | name <- files, not (name`elem`[".",".."])]
    else File<$>il (tryMay $ force<$>P.readFile path)
         <*>il (tryMay $ readBytes path)

_File :: ((Maybe String,Maybe Bytes):+:Map String File) :<->: File
_File = iso f' f
  where f (File x y) = Left (x,y)
        f (Directory d) = Right d
        f' = uncurry File <|> Directory
_DirEntry :: (FilePath,File) :<->: DirEntry
_DirEntry = iso (uncurry DirEntry) (\ ~(DirEntry p f) -> (p,f))
contents :: Traversal' File (Maybe String,Maybe Bytes)
contents = from _File.t'l
children :: Traversal' File (Map String File)
children = from _File.t'r
child :: Traversal' File File
child = children.traverse
descendant :: Fold' File File
descendant = id .+ child.descendant
subEntry :: Traversal' DirEntry DirEntry
subEntry = entryFile.children.keyed.traverse._DirEntry
anyEntry :: Fold' DirEntry DirEntry
anyEntry = id .+ subEntry.anyEntry
entryName :: Lens' DirEntry String
entryName = from _DirEntry.l'1
entryFile :: Lens' DirEntry File
entryFile = from _DirEntry.l'2
text :: Traversal' File String
text = contents.lens fst (const (,zero)).folded
bytes :: Traversal' File Bytes
bytes = contents.l'2.folded

named :: (String -> Bool) -> Traversal' DirEntry DirEntry
named p = sat (\(DirEntry name _) -> p name)
withExtension :: String -> Traversal' DirEntry DirEntry
withExtension e = named (\s -> drop (length s-(length e+1)) s==('.':e))

-- |The working directory, as a DirEntry
workingDirectory :: IO DirEntry
workingDirectory = DirEntry "." <$> (getFile =<< getCurrentDirectory)

modTime :: FilePath -> IO (TimeVal Seconds)
modTime p = try (return minBound) (getModificationTime p <&> pure . realToFrac . utcTimeToPOSIXSeconds)

data Location = Here | Cache | Owner | System

pathTo :: ( ?progName :: FilePath ) => Location -> FilePath
pathTo Here = getCurrentDirectory^.thunk
pathTo Cache = (getTemporaryDirectory^.thunk) </> ?progName + "-" + show (getProcessID^.thunk) 
pathTo Owner = getHomeDirectory^.thunk </> "." + ?progName
pathTo System = "/usr/share" </> ?progName

getConfig :: ( ?progName :: FilePath ) => IO File
getConfig = sum<$>sequence [getFile (pathTo d) | d <- [Owner,System]]

instance NFData File where
  rnf (File _ (Just b)) = rnf b
  rnf (File (Just a) _) = rnf a
  rnf (Directory d) = rnf d
  rnf _ = ()

{-|
The FS monad is a wrapper around the IO monad that provides a
MonadState instance for interacting with the filesystem through the
Filesystem type.

Thus, you may use lenses to access the representation of files as
though they were variables, like so :

> runFS $ (file "x.bmp".bytes.serial.from bmp) fs ^>= \r ->
>     file "foo".bytes.serial.from jpg =- r

-}
newtype FS a = FS { runFS :: IO a }
               deriving (Functor,Unit,Applicative,Monad,MonadFix)
instance MonadState Filesystem FS where
  get = FS (return zero)
  put (Filesystem fs) = FS $ fs`deepseq`for_ (fs^.keyed) $ \(k,f) -> remove k >> putFile k f
    where putFile k (File _ (Just b)) = writeBytes k b
          putFile k (File (Just s) _) = P.writeFile k s
          putFile _ (File _ _) = unit
          putFile k (Directory d) = for_ (d^.keyed) $ \(k',f) -> putFile (k+k') f
          remove f = doesDirectoryExist f >>= \case
            True -> getDirectoryContents f >>= \c -> traverse_ (remove . (f+)) ([]+refuse (`elem`[".",".."]) c)
                                                     >> removeDirectory f
            False -> try unit (removeFile f)
  
newtype Filesystem = Filesystem (Map String File)
                   deriving (Semigroup,Monoid)
instance DataMap Filesystem String File where
  at k = lens f g
    where f (Filesystem m) = Just $ fromMaybe (getFile k^.thunk) $ m^.at k
          g (Filesystem m) x = Filesystem (insert k (fold x) m)

file :: String -> Lens' Filesystem File
file f = at f.folded