~jackwines/fast-bronze

060ca87c28330c65b568cc684f5db455a8eba8d8 — Jack Wines 4 months ago 0707577
major rewrite, still not done
6 files changed, 323 insertions(+), 141 deletions(-)

A cabal.project
A cabal.project.freeze
M fast-bronze.cabal
M src/Catalog.hs
M src/ListZipper.hs
M src/Main.hs
A cabal.project => cabal.project +11 -0
@@ 0,0 1,11 @@
packages: *.cabal

source-repository-package
    type: git
    location: https://github.com/haskell-gi/haskell-gi.git
    branch: master
    tag: d04ecd11d0afeb88ffcc3802ac3c3b589646c51e

jobs: $ncpus
allow-newer: all
-- allow-newer:  pkg:gi-gtk-declarative-app-simple

A cabal.project.freeze => cabal.project.freeze +147 -0
@@ 0,0 1,147 @@
constraints: any.Cabal ==3.2.0.0,
             any.StateVar ==1.2,
             any.adjunctions ==4.4,
             any.ansi-terminal ==0.11,
             ansi-terminal -example,
             any.array ==0.5.4.0,
             any.async ==2.2.2,
             async -bench,
             any.attoparsec ==0.13.2.4,
             attoparsec -developer,
             any.base ==4.14.0.0,
             any.base-compat ==0.11.2,
             any.base-orphans ==0.8.3,
             any.bifunctors ==5.5.8,
             bifunctors +semigroups +tagged,
             any.binary ==0.8.8.0,
             any.blaze-builder ==0.4.1.0,
             any.blaze-html ==0.9.1.2,
             any.blaze-markup ==0.8.2.7,
             any.bytestring ==0.10.10.0,
             any.cabal-doctest ==1.0.8,
             any.call-stack ==0.2.0,
             any.code-page ==0.2,
             any.colour ==2.3.5,
             any.comonad ==5.0.6,
             comonad +containers +distributive +test-doctests,
             any.conduit ==1.3.3,
             any.conduit-extra ==1.3.5,
             any.containers ==0.6.2.1,
             any.contravariant ==1.5.2,
             contravariant +semigroups +statevar +tagged,
             any.data-default-class ==0.1.2.0,
             any.deepseq ==1.4.4.0,
             any.deriving-compat ==0.5.10,
             deriving-compat +base-4-9 +new-functor-classes +template-haskell-2-11,
             any.directory ==1.3.6.0,
             any.distributive ==0.6.2,
             distributive +semigroups +tagged,
             any.doctest ==0.17,
             any.exceptions ==0.10.4,
             any.filepath ==1.4.2.1,
             any.foldl ==1.4.10,
             any.free ==5.1.4,
             any.ghc ==8.10.1,
             any.ghc-boot ==8.10.1,
             any.ghc-boot-th ==8.10.1,
             any.ghc-heap ==8.10.1,
             any.ghc-paths ==0.1.0.12,
             any.ghc-prim ==0.6.1,
             any.ghci ==8.10.1,
             any.gi-atk ==2.0.22,
             any.gi-cairo ==1.0.24,
             any.gi-gdk ==3.0.23,
             any.gi-gdkpixbuf ==2.0.24,
             any.gi-gio ==2.0.27,
             any.gi-glib ==2.0.24,
             any.gi-gobject ==2.0.24,
             any.gi-gtk ==3.0.36,
             any.gi-gtk-declarative ==0.6.3,
             any.gi-gtk-declarative-app-simple ==0.6.3,
             any.gi-harfbuzz ==0.0.3,
             any.gi-pango ==1.0.23,
             any.happy ==1.20.0,
             any.hashable ==1.3.0.0,
             hashable -examples +integer-gmp +sse2 -sse41,
             any.haskell-gi-base ==0.24.4,
             any.haskell-gi-overloading ==1.0,
             any.haskell-lexer ==1.1,
             any.hpc ==0.6.1.0,
             any.hsc2hs ==0.68.7,
             hsc2hs -in-ghc-tree,
             any.integer-gmp ==1.0.3.0,
             any.integer-logarithms ==1.0.3.1,
             integer-logarithms -check-bounds +integer-gmp,
             any.invariant ==0.5.4,
             any.kan-extensions ==5.2.1,
             any.lens ==4.19.2,
             lens -benchmark-uniplate -dump-splices +inlining -j -old-inline-pragmas -safe +test-doctests +test-hunit +test-properties +test-templates +trustworthy,
             any.list-zipper ==0.0.10,
             any.math-functions ==0.3.4.1,
             math-functions +system-erf +system-expm1,
             any.mmorph ==1.1.3,
             any.mono-traversable ==1.0.15.1,
             any.mtl ==2.2.2,
             any.mwc-random ==0.15.0.1,
             any.network ==3.1.2.0,
             network -devel,
             any.parallel ==3.2.2.0,
             any.parsec ==3.1.14.0,
             any.pipes ==4.3.14,
             any.pipes-concurrency ==2.0.12,
             any.pipes-extras ==1.0.15,
             any.pretty ==1.1.3.6,
             any.pretty-show ==1.10,
             any.primitive ==0.7.1.0,
             any.process ==1.6.8.2,
             any.profunctors ==5.6,
             any.random ==1.2.0,
             any.reflection ==2.1.6,
             reflection -slow +template-haskell,
             any.regex-base ==0.94.0.0,
             any.regex-tdfa ==1.3.1.0,
             regex-tdfa -force-o2,
             any.resourcet ==1.2.4.2,
             any.rts ==1.0,
             any.safe ==0.3.19,
             any.scientific ==0.3.6.2,
             scientific -bytestring-builder -integer-simple,
             any.semigroupoids ==5.3.4,
             semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
             any.semigroups ==0.19.1,
             semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
             any.split ==0.2.3.4,
             any.splitmix ==0.1.0.3,
             splitmix -optimised-mixer,
             any.stm ==2.5.0.0,
             any.streaming-commons ==0.2.2.1,
             streaming-commons -use-bytestring-builder,
             any.syb ==0.7.1,
             any.tagged ==0.8.6,
             tagged +deepseq +transformers,
             any.template-haskell ==2.16.0.0,
             any.terminfo ==0.4.1.4,
             any.text ==1.2.3.2,
             any.th-abstraction ==0.4.0.0,
             any.time ==1.9.3,
             any.transformers ==0.5.6.2,
             any.transformers-base ==0.4.5.2,
             transformers-base +orphaninstances,
             any.transformers-compat ==0.6.6,
             transformers-compat -five -five-three -four +generic-deriving +mtl -three -two,
             any.typed-process ==0.2.6.0,
             any.unix ==2.7.2.2,
             any.unliftio-core ==0.2.0.1,
             any.unordered-containers ==0.2.13.0,
             unordered-containers -debug,
             any.vector ==0.12.1.2,
             vector +boundschecks -internalchecks -unsafechecks -wall,
             any.vector-algorithms ==0.8.0.3,
             vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
             any.void ==0.7.3,
             void -safe,
             any.xdg-basedir ==0.2.2,
             any.xml-conduit ==1.8.0.1,
             any.xml-types ==0.3.8,
             any.zlib ==0.6.2.2,
             zlib -bundled-c-zlib -non-blocking-ffi -pkg-config

M fast-bronze.cabal => fast-bronze.cabal +2 -2
@@ 36,7 36,7 @@ executable fast-bronze
  other-modules:       Catalog,
                       ListZipper
  -- other-extensions:
  build-depends:       base ^>=4.12.0.0,
  build-depends:       base,
                       gi-gtk,
                       pipes,
                       pipes-extras,


@@ 54,4 54,4 @@ executable fast-bronze
  -- hs-source-dirs:
  default-language:    Haskell2010
  hs-source-dirs:      src
  ghc-options:         -threaded
\ No newline at end of file
  ghc-options:         -threaded

M src/Catalog.hs => src/Catalog.hs +34 -12
@@ 9,19 9,22 @@ data SearchDir = SearchDir {
                 } deriving (Show)
data Action = Action {
  actionSearchString :: T.Text,
  action :: IO ()
  action :: [Cataloged] -> IO (),
  inputs :: [InputType]
  }

data Cataloged = Cataloged {
  filePath ::  T.Text,
  actions :: [Action]
  inputType :: InputType,
  dirPath ::  T.Text
  } deriving (Show)

data InputType = Folder | Text | Other deriving (Show, Eq)

instance Searchable Action where
  searchString = actionSearchString

instance Searchable Cataloged where
  searchString = T.toLower . T.pack . reverse . takeWhile (/= '/') . reverse . T.unpack . filePath
  searchString = T.toLower . T.pack . reverse . takeWhile (/= '/') . reverse . T.unpack . dirPath

instance Show Action where
  show = T.unpack . searchString


@@ 39,7 42,7 @@ getCatalog = searchCatalogItem SearchDir {
  }

searchCatalogItem :: SearchDir -> IO [Cataloged]
searchCatalogItem (SearchDir depth dir)= do
searchCatalogItem (SearchDir depth dir) = do
  isDir <- P.isDirectory <$> P.getFileStatus dir
  dir' <- D.makeAbsolute dir
  let currCatalog = dirToCatalog dir' isDir


@@ 57,12 60,31 @@ searchCatalogItem (SearchDir depth dir)= do
dirToCatalog :: FilePath -> Bool -> Cataloged
dirToCatalog dir isDir =
  Cataloged {
    filePath = T.pack dir,
    actions = getActions isDir dir
    inputType = if isDir then Folder else Other,
    dirPath = T.pack dir
         }

getActions :: Bool -> FilePath -> [Action]
getActions isDir fp = [Action {
  actionSearchString = "open",
  action = P.executeFile "open" True [fp] Nothing
  }]
-- we only match the first one because the action is always the second thing
-- that's selected, regardless of how many inputs the action takes
validAction :: Action -> Cataloged -> Bool
validAction action = (==) (head . inputs $ action) . inputType

getActions :: Cataloged -> [Action]
getActions cataloged =
  [
    Action {
      actionSearchString = "open",
      action = \[cataloged] ->  P.executeFile "open" True [T.unpack . dirPath $ cataloged] Nothing,
      inputs = [Other]
    },
    Action {
      actionSearchString = "move to trash",
      action = \[cataloged] -> P.executeFile "mv" True [T.unpack . dirPath $ cataloged, "~/.Trash"] Nothing,
      inputs = [Other]
      },
    Action {
      actionSearchString = "move to",
      action = \cataloged -> P.executeFile "mv" True (map (T.unpack . dirPath) cataloged) Nothing,
      inputs = [Other]
      }
  ]

M src/ListZipper.hs => src/ListZipper.hs +7 -0
@@ 21,9 21,16 @@ fromList (x:xs) = Just $ ListZipper [] x xs
map :: (a -> b) -> ListZipper a -> ListZipper b
map f (ListZipper xs x xs') = ListZipper (Prelude.map f xs) (f x) (Prelude.map f xs')

mapFocus :: (a -> a) -> ListZipper a -> ListZipper a
mapFocus f (ListZipper xs x xs') = ListZipper xs (f x) xs'

asList :: ListZipper a -> [a]
asList (ListZipper xs x xs') = reverse xs ++ x:xs'

asListMaybe :: Maybe (ListZipper a) -> [a]
asListMaybe Nothing = []
asListMaybe (Just a) = asList a

zipperFilter :: (a -> Bool) -> ListZipper a -> Maybe (ListZipper a)
zipperFilter p (ListZipper xs x xs') | p x = Just $ ListZipper (filter p xs) x (filter p xs')
zipperFilter p (ListZipper xs x xs') = case filter p xs of

M src/Main.hs => src/Main.hs +122 -127
@@ 31,6 31,7 @@ import qualified Debug.Trace as T
import qualified Data.ByteString as BS
import qualified Data.Vector as Vec
import qualified Control.Monad.IO.Class as M
import qualified Control.Applicative as A
import           Catalog
import qualified ListZipper as LZ



@@ 49,116 50,134 @@ view' s =
      ]
    $ container
      Grid []
      [
        GridChild { -- the top panel
          properties = defaultGridChildProperties {
        [
          GridChild { -- the catalog panel
            properties = defaultGridChildProperties {
              height = 1,
              width = 6,
              topAttach = 0
            },
          child = widget Label [
            child = widget Label [
              #widthRequest := 600,
              #label := topBoxText,
              #hexpand := True,
              #vexpand := True,
              classes topClasses
          ]
        },
        GridChild { -- the bottom panel
           properties = defaultGridChildProperties {
             height = 1,
             width = 6,
             topAttach = 1
           },
           child = widget Label [
             #widthRequest := 600,
             #label := bottomBoxText,
             #hexpand := True,
             #vexpand := True,
             classes bottomClasses
           ]
         },
        GridChild { -- the current matches panel
          properties = defaultGridChildProperties {
            height = 2,
            width = 2,
            topAttach = 0,
            leftAttach = 6
              classes bottomClasses
            ]
          },
          child = container Grid [
            #widthRequest := 200,
            classes ["optionsList"],
            #vexpand := True
          ] selectionOptions
        }
      ]
          GridChild { -- the actions panel
            properties = defaultGridChildProperties {
              height = 1,
              width = 6,
              topAttach = 1
            },
            child = widget Label [
              #widthRequest := 600,
              #label := bottomBoxText,
              #hexpand := True,
              #vexpand := True,
              classes bottomClasses
            ]
          },
          GridChild { -- the current matches panel
            properties = defaultGridChildProperties {
              height = 2,
              width = 2,
              topAttach = 0,
              leftAttach = 6
            },
            child = container Grid [
              #widthRequest := 200,
              classes ["optionslist"],
              #vexpand := True
            ] []-- selectionOptions
          }
        ]
      where
        bottomBoxText = maybe "" (searchString . LZ.focus) . searchActions $ s
        topBoxText = maybe "" (searchString . LZ.focus) . searchCatalog $ s
        bottomBoxText :: T.Text
        bottomBoxText = maybe "" searchString . searchAction $ s

        topBoxText :: T.Text
        topBoxText = maybe "" searchString . searchCatalog $ s

        topClasses :: Vec.Vector Text
        topClasses = case focus s of
          Top _ -> ["selected"]
          Catalog -> ["selected"]
          _ -> ["unselected"]
        bottomClasses = case focus s of
          Bottom _ -> ["selected"]
          Main.Action -> ["selected"]
          _ -> ["unselected"]

        makeGridChild index label = GridChild {
        makeGridChild label index = GridChild {
          properties = defaultGridChildProperties {
            height = 1,
            width = 1,
            topAttach = index
          },
          child = widget Label [#label := label, #vexpand := True, #hexpand := True]
          child = widget Label [#widthRequest := 600, #label := label, #vexpand := True, #hexpand := True]
        }
        selectionOptions = maybe Vec.empty (Vec.zipWith makeGridChild [0..] . Vec.fromList . take 10 . LZ.after) . selectedZipper $ s

update' :: AppState -> Event -> Transition AppState Event
update' _ Closed = Exit
-- remove everything on delete
update' s Delete = Transition s {focus = Top "", searchCatalog = Nothing, searchActions = Nothing} (return Nothing)
update' s Delete = Transition s {search = emptySearch} (return Nothing)
-- flip focus to bottom or top on tab
update' s Tab = Transition s {focus = Main.flip . focus $ s} (return Nothing)
update' s Tab = Transition s {focus = Main.Action, search = emptySearch} (return Nothing)
-- move up or down the catalog/actions
update' s Up =   Transition (selectedZipperRight s) (return Nothing)
update' s Down = Transition (selectedZipperLeft  s) (return Nothing)
-- update' s Up =   Transition (selectedZipperRight s) (return Nothing)
-- update' s Down = Transition (selectedZipperLeft  s) (return Nothing)
-- move right, into the current directory
update' s Main.Right = Transition s $
  case searchCatalog s of
    Nothing -> return Nothing
    Just zipper -> do
      let currPath :: String = T.unpack . filePath . LZ.focus $ zipper
      isDir <- P.isDirectory <$> P.getFileStatus currPath
      if not isDir then return Nothing else do
        childPaths <- map (\x -> getFocusFilePath zipper ++ '/':x) . filterHiddenFiles <$> (D.listDirectory .  getFocusFilePath $ zipper)
        childIsDirs <- mapM (fmap P.isDirectory . P.getFileStatus) childPaths
        return . Just . ReplaceCatalog $ zipWith dirToCatalog childPaths childIsDirs
-- update' s Main.Right = Transition s $
--   case searchCatalog s of
--     [] -> return Nothing
--     [zipper] -> do
--       let currPath :: String = T.unpack . dirPath . LZ.focus $ zipper
--       isDir <- P.isDirectory <$> P.getFileStatus currPath
--       if not isDir then return Nothing else do
--         childPaths <- map (\x -> getFocusFilePath zipper ++ '/':x) . filterHiddenFiles <$> (D.listDirectory .  getFocusFilePath $ zipper)
--         childIsDirs <- mapM (fmap P.isDirectory . P.getFileStatus) childPaths
--         return . Just . ReplaceCatalog $ zipWith dirToCatalog childPaths childIsDirs

update' s (ReplaceCatalog c) = Transition (resetSearchActions (s { searchCatalog = LZ.fromList c, focus = Top "" })) (return Nothing)
-- update' s (ReplaceCatalog c) = Transition (resetSearchActions (s { searchCatalog = LZ.fromList c, focus = Focus 0 "" })) (return Nothing)
update' s (ReplaceCatalog c) = Transition (resetSearchActions (s {search = emptySearch})) (return Nothing)
-- execute the focused action
update' s Enter =
  Transition s (do
    maybe (return ()) (action . head . actions . LZ.focus) . searchCatalog $ s
    return $ Just Closed)
-- update' s Enter = s
  -- Transition s (do
    -- let action' = maybe (const $ return ()) (action . LZ.focus) (searchActions s)
    -- let catalogs = map LZ.focus . searchCatalog $ s
    -- action' catalogs
    -- return $ Just Closed)
update' s (KeyPressed c) = Transition updatedAppState (return Nothing)
  where
    updatedAppState = resetSearchActions $ s' { focus = setCurrSelection (focus s) newSearchText}
    s' = case focus s of
      Top _ -> s { searchCatalog = updateSelectionZipper (catalog s) (searchCatalog s) newSearchText }
      Bottom _ -> s { searchActions = updateSelectionZipper (actions . LZ.focus . fromJust . searchCatalog $ s) (searchActions s) newSearchText }
    newSearchText = Prelude.flip T.snoc c $ currSelection . focus $ s
    updatedAppState = s {
        search = (search s) {searchText = searchText'},
        searchCatalog = if focus s == Catalog then listToMaybe . focused $ catalog s else searchCatalog s,
        searchAction = if focus s == Main.Action then listToMaybe . focused . getActions =<< searchCatalog s else searchAction s
      }


resetSearchActions s = s { searchActions = LZ.fromList . actions =<< LZ.focus <$> searchCatalog s }
    focused :: Searchable a => [a] -> [a]
    focused xs = searchableMatches searchText' xs

    searchText' :: T.Text
    searchText' = T.snoc (searchText . search $ s) c
    -- updatedAppState = resetSearchActions $ s' { focus = setCurrSelection (focus s ) newSearchText}
    -- s' = case focus s of
    --   (Focus 0 txt) -> s { searchCatalog = updateSelectionZipper (catalog s) (searchCatalog s) newSearchText }
    --   (Focus _ _) -> s { searchActions = updateSelectionZipper (actions . LZ.focus . fromJust . searchCatalog $ s) (searchActions s) newSearchText }
    -- newSearchText = Prelude.flip T.snoc c $ currSelection . focus $ s

resetSearchActions s = s -- { searchActions = LZ.fromList . getActions . LZ.focus =<< searchCatalog s }

filterHiddenFiles :: [FilePath] -> [FilePath]
filterHiddenFiles = filter (\(x:xs) -> x /= '.')
filterHiddenFiles = filter (elem '.')

getFocusFilePath :: LZ.ListZipper Cataloged -> FilePath
getFocusFilePath = T.unpack . filePath . LZ.focus
getFocusFilePath = T.unpack . dirPath . LZ.focus

updateSelectionZipper :: Searchable a => [a] -> Maybe (LZ.ListZipper a) -> Text -> Maybe (LZ.ListZipper a)
updateSelectionZipper catalog (Just zipper) txt = LZ.zipperFilter (search txt . searchString) zipper
updateSelectionZipper catalog Nothing txt = LZ.fromList . catalogMatches txt $ catalog
-- updateSelectionZipper :: Searchable a => [a] -> Maybe (LZ.ListZipper a) -> Text -> Maybe (LZ.ListZipper a)
-- updateSelectionZipper catalog (Just zipper) txt = LZ.zipperFilter (search txt . searchString) zipper
-- updateSelectionZipper catalog Nothing txt = LZ.fromList . catalogMatches txt $ catalog

main :: IO ()
main = do


@@ 202,72 221,48 @@ handleKeyPress key window = do
             char -> KeyPressed . C.chr $ char)

initialAppState catalog' = AppState {
  focus = Top "",
  catalog = catalog',
  searchCatalog = Nothing,
  searchActions = Nothing
  searchAction = Nothing,
  search = emptySearch,
  focus = Catalog
  }

currFile :: AppState -> Maybe Text
currFile s = case focus s of
  Top txt -> Just txt
  Bottom _ -> Nothing

currAction :: AppState -> Maybe Text
currAction s = case focus s of
  Bottom txt -> Just txt
  Top _ -> Nothing

currSelection :: Focus -> Text
currSelection (Top txt) = txt
currSelection (Bottom txt) = txt

setCurrSelection :: Focus -> Text -> Focus
setCurrSelection (Top _) txt = Top txt
setCurrSelection (Bottom _) txt = Bottom txt

mapCurrSelection ::  (Text -> Text) -> Focus -> Focus
mapCurrSelection f (Top txt) = Top . f $ txt
mapCurrSelection f (Bottom txt) = Bottom . f $ txt

selectedZipper :: AppState -> Maybe (LZ.ListZipper Text)
selectedZipper s = case focus s of
  (Top _)    -> LZ.map searchString <$> searchCatalog s
  (Bottom _) -> LZ.map searchString <$> searchActions s

selectedZipperLeft :: AppState  -> AppState
selectedZipperLeft s = case focus s of
  Bottom _ -> s {searchActions = fmap LZ.moveLeft (searchActions s)}
  Top _    -> s {searchCatalog = fmap LZ.moveLeft (searchCatalog s)}

selectedZipperRight :: AppState -> AppState
selectedZipperRight s = case focus s of
  Bottom _ -> s {searchActions = fmap LZ.moveRight (searchActions s)}
  Top _    -> s {searchCatalog = fmap LZ.moveRight (searchCatalog s)}
emptySearch :: SearchTelescope
emptySearch = SearchTelescope {
      searchText = "",
      numScrolls = 0
                           }

data AppState = AppState {
  focus :: Focus,
  catalog :: [Cataloged],
  searchCatalog :: Maybe (LZ.ListZipper Cataloged),
  searchActions :: Maybe (LZ.ListZipper Action)
  searchCatalog :: Maybe Cataloged,
  searchAction :: Maybe Action,
  focus :: Focus,
  search :: SearchTelescope
                         }

mapOverFocus :: (Text -> Text) -> Focus -> Focus
mapOverFocus f (Top s) = Top $ f s
mapOverFocus f (Bottom s) = Bottom $ f s
-- what should be highlighted? The catalog or the actions
data Focus = Action | Catalog deriving Eq

-- keeps track of current search. What they've typed, how much they've scrolled, .etc
data SearchTelescope = SearchTelescope {
  searchText :: T.Text,
  numScrolls :: Word
                     } deriving Eq

flip :: Focus -> Focus
flip (Top _) = Bottom ""
flip (Bottom _) = Top ""
-- mapOverFocus :: (Text -> Text) -> Focus -> Focus
-- mapOverFocus f (Focus n t) = Focus n (f t)

data Focus = Top Text | Bottom Text deriving (Eq)
-- advance :: Word -> Focus -> Focus
-- advance numFrames (Focus selection _) = Focus (succ selection `mod` numFrames) ""

catalogMatches :: Searchable s => T.Text -> [s] -> [s]
catalogMatches s = filter (search s . searchString)
searchableMatches :: Searchable s => T.Text -> [s] -> [s]
searchableMatches s = filter (fuzzyMatches s . searchString)

search :: T.Text -> T.Text -> Bool
search "" _ = True
search _ "" = False
search s s' = if T.head s == T.head s'
  then search (T.tail s) (T.tail s')
              else search s (T.tail s')
fuzzyMatches :: T.Text -> T.Text -> Bool
fuzzyMatches "" _ = True
fuzzyMatches _ "" = False
fuzzyMatches s s'
  | T.head s == T.head s' = fuzzyMatches (T.tail s) (T.tail s')
  | otherwise = fuzzyMatches s (T.tail s')