Update freeze file

.gitignore

@@ -1,9 +1,15 @@
-dist/
-.cabal-sandbox/
-cabal.sandbox.config
-*~
 *.hp
-*.prof
 *.old
+*.prof
+*~
+.cabal-sandbox/
+.ghc.environment.*
 .liquid/
+.stack-work/
 3rdparty/hpath
+cabal.sandbox.config
+dist-newstyle/
+dist/
+hscope.out
+.ghcup
+/bin/

README.md

@@ -22,11 +22,7 @@ Installation
 ------------
 
 ```
-cabal sandbox init
+./install.sh
-cabal install alex happy
-export PATH="$(pwd)/.cabal-sandbox/bin:$PATH"
-cabal install gtk2hs-buildtools
-cabal install
 ```
 
 

cabal.project

@@ -0,0 +1,10 @@
+with-compiler: ghc-8.6.5
+
+packages: .
+
+optimization: 2
+
+package *
+    optimization: 2
+
+index-state: 2020-01-24T20:23:40Z

cabal.project.freeze

@@ -0,0 +1,80 @@
+constraints: any.Cabal ==2.4.0.1,
+             any.IfElse ==0.85,
+             any.abstract-deque ==0.3,
+             abstract-deque -usecas,
+             any.alex ==3.2.5,
+             alex +small_base,
+             any.array ==0.5.3.0,
+             any.atomic-primops ==0.8.3,
+             atomic-primops -debug,
+             any.base ==4.12.0.0,
+             any.base-orphans ==0.8.1,
+             any.binary ==0.8.6.0,
+             any.bytestring ==0.10.8.2,
+             any.cairo ==0.13.8.0,
+             cairo +cairo_pdf +cairo_ps +cairo_svg,
+             any.containers ==0.6.0.1,
+             any.deepseq ==1.4.4.0,
+             any.directory ==1.3.3.0,
+             any.exceptions ==0.10.4,
+             exceptions +transformers-0-4,
+             any.filepath ==1.4.2.1,
+             any.ghc-boot-th ==8.6.5,
+             any.ghc-prim ==0.5.3,
+             any.gio ==0.13.8.0,
+             any.glib ==0.13.8.0,
+             glib +closure_signals,
+             any.gtk2hs-buildtools ==0.13.8.0,
+             gtk2hs-buildtools +closuresignals,
+             any.gtk3 ==0.15.4,
+             gtk3 -build-demos +fmode-binary +have-gio,
+             any.happy ==1.19.12,
+             happy +small_base,
+             any.hashable ==1.3.0.0,
+             hashable -examples +integer-gmp +sse2 -sse41,
+             any.hashtables ==1.2.3.4,
+             hashtables -bounds-checking -debug -detailed-profiling -portable -sse42 +unsafe-tricks,
+             any.heaps ==0.3.6.1,
+             any.hinotify-bytestring ==0.3.8.1,
+             any.hpath ==0.11.0,
+             any.hpath-filepath ==0.10.3,
+             any.hpath-io ==0.12.0,
+             any.hsc2hs ==0.68.6,
+             hsc2hs -in-ghc-tree,
+             any.integer-gmp ==1.0.2.0,
+             any.lockfree-queue ==0.2.3.1,
+             any.monad-control ==1.0.2.3,
+             any.monad-loops ==0.4.3,
+             monad-loops +base4,
+             any.mtl ==2.2.2,
+             any.network ==3.1.1.1,
+             any.old-locale ==1.0.0.7,
+             any.pango ==0.13.8.0,
+             pango +new-exception,
+             any.parsec ==3.1.13.0,
+             any.pretty ==1.1.3.6,
+             any.primitive ==0.7.0.0,
+             any.process ==1.6.5.0,
+             any.random ==1.1,
+             any.rts ==1.0,
+             any.safe ==0.3.18,
+             any.safe-exceptions ==0.1.7.0,
+             any.simple-sendfile ==0.2.30,
+             simple-sendfile +allow-bsd,
+             any.stm ==2.5.0.0,
+             any.streamly ==0.7.0,
+             streamly -benchmark -debug -dev -examples -examples-sdl -has-llvm -inspection -no-charts -no-fusion -streamk,
+             any.template-haskell ==2.14.0.0,
+             any.text ==1.2.3.1,
+             any.time ==1.8.0.2,
+             any.transformers ==0.5.6.2,
+             any.transformers-base ==0.4.5.2,
+             transformers-base +orphaninstances,
+             any.transformers-compat ==0.6.5,
+             transformers-compat -five +five-three -four +generic-deriving +mtl -three -two,
+             any.unix ==2.7.2.2,
+             any.unix-bytestring ==0.3.7.3,
+             any.utf8-string ==1.0.1.1,
+             any.vector ==0.12.0.3,
+             vector +boundschecks -internalchecks -unsafechecks -wall,
+             any.word8 ==0.1.3

hsfm.cabal

@@ -32,12 +32,14 @@ library
                        HSFM.Utils.MyPrelude
 
   build-depends:
+                       IfElse,
                        base >= 4.8 && < 5,
                        bytestring,
                        filepath >= 1.3.0.0,
                        hinotify-bytestring,
-                       hpath >= 0.8.0,
+                       hpath >= 0.11.0 ,
-                       IfElse,
+                       hpath-filepath >= 0.10.3,
+                       hpath-io >= 0.12.0,
                        safe,
                        stm,
                        time >= 1.4.2,
@@ -77,15 +79,17 @@ executable hsfm-gtk
 
   build-depends:
                        Cabal >= 1.22.0.0,
+                       IfElse,
                        base >= 4.8 && < 5,
                        bytestring,
                        filepath >= 1.3.0.0,
                        glib >= 0.13,
                        gtk3 >= 0.14.1,
                        hinotify-bytestring,
-                       hpath >= 0.8.0,
+                       hpath >= 0.11.0 ,
+                       hpath-filepath >= 0.10.3,
+                       hpath-io >= 0.12.0,
                        hsfm,
-                       IfElse,
                        monad-loops,
                        old-locale >= 1,
                        process,

install.sh

@@ -0,0 +1,42 @@
+#!/bin/sh
+
+set -eu
+
+SCRIPT_DIR="$(CDPATH="" cd -- "$(dirname -- "$0")" && pwd -P)"
+
+cd "${SCRIPT_DIR}"
+
+# install ghcup
+if ! [ -e "${SCRIPT_DIR}"/.ghcup/bin/ghcup ] ; then
+    mkdir -p "${SCRIPT_DIR}"/.ghcup/bin
+    curl --proto '=https' --tlsv1.2 -sSf https://gitlab.haskell.org/haskell/ghcup/raw/master/ghcup > "${SCRIPT_DIR}"/.ghcup/bin/ghcup
+    chmod +x "${SCRIPT_DIR}"/.ghcup/bin/ghcup
+fi
+
+# set up environment
+export PATH="${SCRIPT_DIR}/.ghcup/bin:$PATH"
+export GHCUP_INSTALL_BASE_PREFIX="${SCRIPT_DIR}"
+
+# get ghc version from cabal.project
+ghc_ver=$(grep with-compiler cabal.project | awk '{print $2}' | sed 's/ghc-//')
+
+# install ghc
+if ! ghcup list -t ghc -c installed -r | grep -q "${ghc_ver}" ; then
+    ghcup install "${ghc_ver}"
+fi
+
+# install cabal-install
+if [ -z "$(ghcup list -t cabal-install -c installed -r)" ] ; then
+    ghcup install-cabal
+fi
+
+[ -e "${SCRIPT_DIR}"/bin ] || mkdir "${SCRIPT_DIR}"/bin
+
+# install binary
+cabal v2-install \
+    --installdir="${SCRIPT_DIR}"/bin \
+    --install-method=copy \
+    --overwrite-policy=always
+
+echo "Binary installed in: ${SCRIPT_DIR}/bin"
+

src/HSFM/FileSystem/UtilTypes.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -48,7 +47,7 @@ import HPath
   (
     Path
   , Abs
-  , Fn
+  , Rel
   )
 
 
@@ -80,5 +79,5 @@ data FCollisonMode = Strict  -- ^ fail if the target already exists
                    | Overwrite
                    | OverwriteAll
                    | Skip
-                   | Rename (Path Fn)
+                   | Rename (Path Rel)
 

src/HSFM/GUI/Glib/GlibString.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -67,7 +66,7 @@ instance GlibString BS.ByteString where
     newUTFStringLen = newUTFStringLen . toString
     genUTFOfs = genUTFOfs . toString
     stringLength = BS.length
-    unPrintf s = BS.intercalate "%%" (BS.split _percent s)
+    unPrintf s = BS.intercalate (BS.pack [_percent, _percent]) (BS.split _percent s)
 
 
 foreign import ccall unsafe "string.h strlen" c_strlen

src/HSFM/GUI/Gtk.hs

@@ -16,17 +16,18 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 module Main where
 
 
+import qualified Data.ByteString as BS
 import Data.Maybe
   (
     fromJust
   , fromMaybe
   )
+import Data.Word8
 import Graphics.UI.Gtk
 import qualified HPath as P
 import HSFM.FileSystem.FileType
@@ -45,15 +46,17 @@ import System.IO.Error
   )
 import qualified System.Posix.Env.ByteString as SPE
 
+slash :: BS.ByteString
+slash = BS.singleton _slash
 
 main :: IO ()
 main = do
   args <- SPE.getArgs
-  let mdir = fromMaybe (fromJust $ P.parseAbs "/")
+  let mdir = fromMaybe (fromJust $ P.parseAbs slash)
-                       (P.parseAbs . headDef "/" $ args)
+                       (P.parseAbs . headDef slash $ args)
 
   file <- catchIOError (pathToFile getFileInfo mdir) $
-    \_ -> pathToFile getFileInfo  . fromJust $ P.parseAbs "/"
+    \_ -> pathToFile getFileInfo  . fromJust $ P.parseAbs slash
 
   _ <- initGUI
   mygui <- createMyGUI

src/HSFM/GUI/Gtk/Callbacks.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
@@ -479,7 +478,7 @@ operationFinal mygui myview mitem = withErrorDialog $ do
 newFile :: MyGUI -> MyView -> IO ()
 newFile _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter file name" ("" :: String)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createRegularFile newFilePerms (path cdir P.</> fn)
@@ -489,7 +488,7 @@ newFile _ myview = withErrorDialog $ do
 newDir :: MyGUI -> MyView -> IO ()
 newDir _ myview = withErrorDialog $ do
   mfn   <- textInputDialog "Enter directory name" ("" :: String)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     cdir  <- getCurrentDir myview
     createDir newDirPerms (path cdir P.</> fn)
@@ -499,7 +498,7 @@ renameF :: [Item] -> MyGUI -> MyView -> IO ()
 renameF [item] _ _ = withErrorDialog $ do
   iname <- P.fromRel <$> (P.basename $ path item)
   mfn  <- textInputDialog "Enter new file name" (iname :: ByteString)
-  let pmfn = P.parseFn =<< fromString <$> mfn
+  let pmfn = P.parseRel =<< fromString <$> mfn
   for_ pmfn $ \fn -> do
     let cmsg = "Really rename \"" ++ getFPasStr item
                ++ "\"" ++ " to \""

src/HSFM/GUI/Gtk/Callbacks/Utils.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 

src/HSFM/GUI/Gtk/Dialogs.hs

@@ -71,7 +71,11 @@ import Distribution.PackageDescription
     GenericPackageDescription(..)
   , PackageDescription(..)
   )
+#if MIN_VERSION_Cabal(2,2,0)
+import Distribution.PackageDescription.Parsec
+#else
 import Distribution.PackageDescription.Parse
+#endif
   (
 #if MIN_VERSION_Cabal(2,0,0)
     readGenericPackageDescription,
@@ -167,7 +171,7 @@ fileCollisionDialog t = do
     ResponseUser 4 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (fromString fn)
+        pfn <- P.parseRel (fromString fn)
         return $ Rename pfn
     _              -> throwIO UnknownDialogButton
 
@@ -192,7 +196,7 @@ renameDialog t = do
     ResponseUser 2 -> do
       mfn   <- textInputDialog (fromString "Enter new name") (takeFileName t)
       forM mfn $ \fn -> do
-        pfn <- P.parseFn (fromString fn)
+        pfn <- P.parseRel (fromString fn)
         return $ Rename pfn
     _              -> throwIO UnknownDialogButton
 
@@ -250,9 +254,9 @@ withErrorDialog io =
 
 -- |Asks the user which directory copy mode he wants via dialog popup
 -- and returns 'DirCopyMode'.
-textInputDialog :: GlibString string
+textInputDialog :: (GlibString s1, GlibString s2)
-                => string   -- ^ window title
+                => s1   -- ^ window title
-                -> string   -- ^ initial text in input widget
+                -> s2   -- ^ initial text in input widget
                 -> IO (Maybe String)
 textInputDialog title inittext = do
   chooserDialog <- messageDialogNew Nothing

src/HSFM/Settings.hs

@@ -16,7 +16,6 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 --}
 
-{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_HADDOCK ignore-exports #-}
 
 
@@ -27,6 +26,7 @@ import Data.ByteString
   (
     ByteString
   )
+import qualified Data.ByteString.UTF8 as BU
 import Data.Maybe
 import System.Posix.Env.ByteString
 import System.Posix.Process.ByteString
@@ -49,11 +49,11 @@ import System.Posix.Process.ByteString
 terminalCommand :: ByteString  -- ^ current directory of the FM
                 -> IO a
 terminalCommand cwd =
-  executeFile   -- executes the given command
+  executeFile                   -- executes the given command
-    "sakura"    -- the terminal command
+    (BU.fromString "sakura")    -- the terminal command
-    True        -- whether to search PATH
+    True                        -- whether to search PATH
-    ["-d", cwd] -- arguments for the command
+    [BU.fromString "-d", cwd]   -- arguments for the command
-    Nothing     -- optional custom environment: `Just [(String, String)]`
+    Nothing                     -- optional custom environment: `Just [(String, String)]`
 
 
 -- |The home directory. If you want to set it explicitly, you might
@@ -63,5 +63,5 @@ terminalCommand cwd =
 -- home = return "\/home\/wurst"
 -- @
 home :: IO ByteString
-home = fromMaybe <$> return "/" <*> getEnv "HOME"
+home = fromMaybe <$> return (BU.fromString "/") <*> getEnv (BU.fromString "HOME")
 

update-index-state.sh

@@ -0,0 +1,66 @@
+#!/usr/bin/env bash
+
+set -eu
+
+status_message() {
+    printf "\\033[0;32m%s\\033[0m\\n" "$1"
+}
+
+error_message() {
+    printf "\\033[0;31m%s\\033[0m\\n" "$1"
+}
+
+SCRIPTPATH="$( cd "$(dirname "$0")" ; pwd -P )"
+CACHE_LOCATION="${HOME}/.cabal/packages/hackage.haskell.org/01-index.cache"
+
+if [ ! -f "${CACHE_LOCATION}" ] ; then
+	error_message "${CACHE_LOCATION} does not exist, did you run 'cabal update'?"
+	exit 1
+fi
+
+if [ ! -f "${SCRIPTPATH}/cabal.project" ] ; then
+	error_message "Could not find ${SCRIPTPATH}/cabal.project, skipping index state update."
+	exit 3
+fi
+
+cabal v2-update
+
+arch=$(getconf LONG_BIT)
+
+case "${arch}" in
+32)
+	byte_size=4
+	magic_word="CABA1002"
+    ;;
+64)
+	byte_size=8
+	magic_word="00000000CABA1002"
+    ;;
+*)
+	error_message "Unknown architecture (long bit): ${arch}"
+	exit 2
+    ;;
+esac
+
+# This is the logic to parse the binary format of 01-index.cache.
+# The first word is a magic 'caba1002', the second one is the timestamp in unix epoch.
+# Better than copying the cabal-install source code.
+if [ "$(xxd -u -p -l${byte_size} -s 0 "${CACHE_LOCATION}")" != "${magic_word}" ] ; then
+	error_message "Magic word does not match!"
+	exit 4
+fi
+cache_timestamp=$(echo "ibase=16;obase=A;$(xxd -u -p -l${byte_size} -s ${byte_size} "${CACHE_LOCATION}")" | bc)
+
+# If we got junk from the binary file, this should fail.
+cache_date=$(date --utc --date "@${cache_timestamp}" "+%FT%TZ")
+
+
+status_message "Updating index state in ${SCRIPTPATH}/cabal.project"
+
+if grep -q "^index-state: .*" "${SCRIPTPATH}/cabal.project" ; then
+	awk '/index-state:/ {gsub(/.*/, "index-state: '${cache_date}'")}; { print }' "${SCRIPTPATH}/cabal.project" > "${SCRIPTPATH}/cabal.project.tmp"
+	mv "${SCRIPTPATH}/cabal.project.tmp" "${SCRIPTPATH}/cabal.project"
+else
+	printf "index-state: %s\n" "${cache_date}" >> "${SCRIPTPATH}/cabal.project"
+fi
+