    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Diagrams.Util
    -- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  diagrams-discuss@googlegroups.com
    --
    -- Some miscellaneous utilities provided by the diagrams-lib package.
    --
    -----------------------------------------------------------------------------

    module Diagrams.Util
      ( -- * Utilities for users

        with
      , applyAll
      , (#)
      , (##)

      , iterateN

      , tau

        -- * Finding files
      , findHsFile

        -- * Finding sandboxes
      , findSandbox
      , globalPackage

        -- * Internal utilities
      , foldB

      ) where

    import           Control.Applicative
    import           Control.Lens              hiding (( # ))
    import           Control.Monad
    import           Control.Monad.Catch
    import           Control.Monad.Trans
    import           Control.Monad.Trans.Maybe
    import           Data.Default.Class
    import           Data.List
    import           Data.List.Lens
    import           Data.Maybe
    import           Data.Monoid
    import           System.Directory
    import           System.Environment
    import           System.FilePath
    import           System.FilePath.Lens
    import           System.Process

    -- | Several functions exported by the diagrams library take a number
    --   of arguments giving the user control to \"tweak\" various aspects
    --   of their behavior.  Rather than give such functions a long list
    --   of arguments, and to make it possible for the user to selectively
    --   override only certain arguments and use default values for
    --   others, such sets of arguments are collected into a record with
    --   named fields (see 'PolygonOpts' in "Diagrams.TwoD.Shapes" for an
    --   example).  Such record types are made instances of the 'Default'
    --   class, which provides a single record structure ('def')
    --   collecting the \"default\" arguments to the function.  @with@ is
    --   a synonym for 'def', which provides nice-looking syntax for
    --   simulating optional, named arguments in Haskell.  For example,
    --
    --   @
    --   polygon with {sides = 7, edgeSkip = 2}
    --   @
    --
    --   calls the 'polygon' function with a single argument (note that
    --   record update binds more tightly than function application!),
    --   namely, 'with' (the record of default arguments) where the
    --   @sides@ and @edgeSkip@ fields have been updated.
    with :: Default d => d
    with = def

    -- | @applyAll@ takes a list of functions and applies them all to a
    --   value, in sequence from the last function in the list to the first.
    --   For example, @applyAll [f1, f2, f3] a == f1 . f2 . f3 $ a@.
    applyAll :: [a -> a] -> a -> a
    applyAll = appEndo . mconcat . map Endo

    infixl 8 #

    -- | Postfix function application, for conveniently applying
    --   attributes.  Unlike @($)@, @(#)@ has a high precedence (8), so @d
    --   \# foo \# bar@ can be combined with other things using operators
    --   like @(|||)@ or @(\<\>)@ without needing parentheses.
    (#) :: a -> (a -> b) -> b
    (#) = flip ($)

    -- | A replacement for lenses' 'Control.Lens.Review.#' operator.
    (##) :: AReview t b -> b -> t
    (##) = review
    {-# INLINE (##) #-}
    infixr 8 ##

    -- | @iterateN n f x@ returns the list of the first @n@ iterates of
    --   @f@ starting at @x@, that is, the list @[x, f x, f (f x), ...]@
    --   of length @n@. (Note that the last element of the list will be
    --   @f@ applied to @x@ @(n-1)@ times.)
    iterateN :: Int -> (a -> a) -> a -> [a]
    iterateN n f = take n . iterate f

    -- | The circle constant, the ratio of a circle's circumference to its
    --   /radius/.  Note that @pi = tau/2@.
    --
    --   For more information and a well-reasoned argument why we should
    --   all be using tau instead of pi, see /The Tau Manifesto/,
    --   <http://tauday.com/>.
    --
    --   To hear what it sounds like (and to easily memorize the first 30
    --   digits or so), try <http://youtu.be/3174T-3-59Q>.
    tau :: Floating a => a
    tau = 2*pi

    -- | Given an associative binary operation and a default value to use
    --   in the case of an empty list, perform a /balanced/ fold over a
    --   list.  For example,
    --
    --   @
    --   foldB (+) z [a,b,c,d,e,f] == ((a+b) + (c+d)) + (e+f)
    --   @
    --
    foldB :: (a -> a -> a) -> a -> [a] -> a
    foldB _ z [] = z
    foldB f _ as = foldB' as
      where foldB' [x] = x
            foldB' xs  = foldB' (go xs)
            go []         = []
            go [x]        = [x]
            go (x1:x2:xs) = f x1 x2 : go xs

    ------------------------------------------------------------------------
    -- Files
    ------------------------------------------------------------------------

    -- | Given some file (no extension or otherwise) try to find a haskell
    --   source file.
    findHsFile :: FilePath -> IO (Maybe FilePath)
    findHsFile file = runMaybeT $ hs <|> lhs
      where
        hs      = check (addExtension file "hs")
        lhs     = check (addExtension file "lhs")
        check f = do
          lift (doesFileExist f) >>= guard
          pure f

    ------------------------------------------------------------------------
    -- Sandbox
    ------------------------------------------------------------------------

    -- | Parse cabal config file to find the location of the package
    --   database.
    parseConfig :: FilePath -> MaybeT IO FilePath
    parseConfig file = do
      config <- maybeIO $ readFile file
      hoistMaybe $ config ^? lined . prefixed "package-db: "

    -- | Seach the given directory and all parent directories until a cabal
    --   config file is found. First search for \"cabal.config\", then
    --   \"cabal.sandbox.config\". Return the location of the package
    --   database in the config file.
    configSearch :: FilePath -> MaybeT IO FilePath
    configSearch p0 = do
      p0' <- maybeIO $ canonicalizePath p0

      let mkPaths p
            | all isPathSeparator p || p == "."
                        = []
            | otherwise = (p </> "cabal.sandbox.config")
                        : mkPaths (p ^. directory)

      foldMaybeT parseConfig (mkPaths p0')

    -- | Check if the folder is a database, or if it contains a database.
    --   Returns the database location if it's found.
    isDB :: FilePath -> MaybeT IO FilePath
    isDB path =
      if isConf path
        then return path
        else maybeIO (getDirectoryContents path) >>= hoistMaybe . find isConf
        where
          isConf = isSuffixOf ".conf.d"

    -- | Search for a sandbox in the following order:
    --
    --   * Test given FilePaths if they point directly to a database or
    --     contain a cabal config file (or any parent directory containing a
    --     config file).
    --
    --   * Same test for @DIAGRAMS_SANDBOX@ environment value
    --
    --   * Environment values of @GHC_PACKAGE_PATH@, @HSENV@ and
    --     @PACKAGE_DB_FOR_GHC@ that point to a database.
    --
    --   * Test for config file (cabal.sandbox.config) in the current
    --     directory and its parents.
    --
    findSandbox :: [FilePath] -> IO (Maybe FilePath)
    findSandbox paths = runMaybeT $ pathsTest <|> diaSB <|> envDB <|> wdConfig
      where
        -- first path in environment
        lookEnv = MaybeT . (fmap . fmap) (head . splitSearchPath) . lookupEnv
        envDB   = foldMaybeT lookEnv ["GHC_PACKAGE_PATH", "HSENV", "PACKAGE_DB_FOR_GHC"]

        -- test if path points directly to db or contains a config file
        test x    = isDB x <|> configSearch x
        pathsTest = foldMaybeT test paths
        diaSB     = lookEnv "DIAGRAMS_SANDBOX" >>= test
        wdConfig  = maybeIO getCurrentDirectory >>= configSearch

    -- -- | Use the given path for the sandbox in the @GHC_PACKAGE_PATH@
    -- --   environment (appending the ghc global package database from @ghc
    -- --   --info@. @GHC_PACKAGE_PATH@ if the variable ghc and other tools use
    -- --   to find the package database. (This is what @cabal exec@ sets)
    -- ghcPackagePath :: FilePath -> IO ()
    -- ghcPackagePath db = do
    --   gdb <- globalPackage
    --   let dbs = intercalate [searchPathSeparator] [db,gdb]
    --   setEnv "GHC_PACKAGE_PATH" dbs
    -- -- setEnv is only in base > 4.7, either need to use setenv package or
    -- -- -package-db flag

    -- | Find ghc's global package database. Throws an error if it isn't
    --   found.
    globalPackage :: IO FilePath
    globalPackage = do
      info <- read <$> readProcess "ghc" ["--info"] ""
      return $ fromMaybe (error "Unable to parse ghc --info.")
                         (lookup "Global Package DB" info)

    -- MaybeT utilities

    -- | Lift an 'IO' action. If any exceptions are raised, return Nothing.
    maybeIO :: (MonadCatch m, MonadIO m) => IO a -> MaybeT m a
    maybeIO io = liftIO io `catchAll` const mzero

    -- | Lift a maybe value to a MaybeT of any monad.
    hoistMaybe :: Monad m => Maybe a -> MaybeT m a
    hoistMaybe = MaybeT . return

    -- | Fold a list of 'MaybeT's that short-circuits as soon as a Just value
    --   is found (instead going through the whole list).
    foldMaybeT :: Monad m => (a -> MaybeT m b) -> [a] -> MaybeT m b
    foldMaybeT _ []     = mzero
    foldMaybeT f (a:as) = MaybeT $ do
      x <- runMaybeT (f a)
      if isJust x
        then return x
        else runMaybeT (foldMaybeT f as)