module Codex (Codex(..), Verbosity, module Codex) where
import Control.Exception (try, SomeException)
import Control.Monad
import Control.Monad.Error
import Data.Traversable (sequenceA)
import Distribution.Package
import Distribution.PackageDescription
import Distribution.Verbosity
import Network.Curl.Download.Lazy
import System.Directory
import System.FilePath
import System.Process
import qualified Codec.Archive.Tar as Tar
import qualified Codec.Compression.GZip as GZip
import qualified Data.ByteString.Lazy as BS
import qualified Data.List as List
import Codex.Internal
data Tagging = Tagged | Untagged
deriving (Eq, Show)
fromBool :: Bool -> Tagging
fromBool True = Tagged
fromBool False = Untagged
data Status = Source Tagging | Archive | Remote
deriving (Eq, Show)
type Action = ErrorT String IO
tryIO :: IO a -> Action a
tryIO io = do
res <- liftIO $ (try :: IO a -> IO (Either SomeException a)) io
either (throwError . show) return res
status :: Codex -> PackageIdentifier -> Action Status
status cx i = do
sourcesExist <- tryIO . doesDirectoryExist $ packageSources cx i
archiveExist <- tryIO . doesFileExist $ packageArchive cx i
case (sourcesExist, archiveExist) of
(True, _) -> fmap (Source . fromBool) (liftIO . doesFileExist $ packageTags cx i)
(_, True) -> return Archive
(_, _) -> return Remote
fetch :: Codex -> PackageIdentifier -> Action FilePath
fetch cx i = do
bs <- tryIO $ do
createDirectoryIfMissing True (packagePath cx i)
openLazyURI url
either throwError write bs where
write bs = fmap (const archivePath) $ tryIO $ BS.writeFile archivePath bs
archivePath = packageArchive cx i
url = packageUrl i
extract :: Codex -> PackageIdentifier -> Action FilePath
extract cx i = fmap (const path) . tryIO $ read path (packageArchive cx i) where
read dir tar = Tar.unpack dir . Tar.read . GZip.decompress =<< BS.readFile tar
path = packagePath cx i
tags :: Codex -> PackageIdentifier -> Action FilePath
tags cx i = do
tryIO . createProcess $ shell command
return tags where
command = concat ["ctags --tag-relative=no --recurse -f '", tags, "' '", sources, "'"]
sources = packageSources cx i
tags = packageTags cx i
assembly :: Codex -> [PackageIdentifier] -> FilePath -> Action FilePath
assembly cx is o = tryIO . fmap (const o) $ mergeTags (fmap tags is) o where
mergeTags files o = do
contents <- sequence $ fmap readFile files
let xs = List.sort . (List.filter (\x -> List.head x /= '!')) . concat $ fmap lines contents
writeFile o $ unlines (concat [header, xs])
tags i = packageTags cx i
header = ["!_TAG_FILE_FORMAT 2", "!_TAG_FILE_SORTED 1"]