-- | the 'IsRegex' class allows polymorhic tools to be written that
-- will work with a variety of regex back ends and text types
class Replace s => IsRegex re s where
  -- | finding the first match
  matchOnce             :: re -> s -> Match s
  -- | finding all matches
  matchMany             :: re -> s -> Matches s
  -- | compiling an RE, failing if the RE is not well formed
  makeRegex             :: (Functor m,Monad m, MonadFail m) => s -> m re
  -- | comiling an RE, specifying the 'SimpleREOptions'
  makeRegexWith         :: (Functor m,Monad m, MonadFail m) => SimpleREOptions -> s -> m re
  -- | compiling a 'SearchReplace' template from the RE text and the template Text, failing if they are not well formed
  makeSearchReplace     :: (Functor m,Monad m, MonadFail m,IsRegex re s) => s -> s -> m (SearchReplace re s)
  -- | compiling a 'SearchReplace' template specifing the 'SimpleREOptions' for the RE
  makeSearchReplaceWith :: (Functor m,Monad m, MonadFail m,IsRegex re s) => SimpleREOptions -> s -> s -> m (SearchReplace re s)
  -- | incorporate an escaped string into a compiled RE with the default options
  makeEscaped           :: (Functor m,Monad m, MonadFail m) => (s->s) -> s -> m re
  -- | incorporate an escaped string into a compiled RE with the specified 'SimpleREOptions'
  makeEscapedWith       :: (Functor m,Monad m, MonadFail m) => SimpleREOptions -> (s->s) -> s -> m re
  -- | extract the text of the RE from the RE
  regexSource           :: re -> s

  makeRegex           = makeRegexWith         minBound
  makeSearchReplace   = makeSearchReplaceWith minBound
  makeEscaped         = makeEscapedWith       minBound
  makeEscapedWith o f = makeRegexWith o . f . packR . escapeREString . unpackR

-- | an 'Edits' script will, for each line in the file, either perform
-- the action selected by the first RE in the list, or perform all of the
-- actions on line, arranged as a pipeline
data Edits m re s
  = Select ![Edit m re s]   -- ^ for each line select the first @Edit@ to match each line and edit the line with it
  | Pipe   ![Edit m re s]   -- ^ for each line apply every edit that matches in turn to the line

-- | each Edit action specifies how the match should be processed
data Edit m re s
  = Template !(SearchReplace re s)
        -- ^ replace the match with this template text, substituting ${capture} as apropriate
  | Function !re REContext !(LineNo->Match s->RELocation->Capture s->m (Maybe s))
        -- ^ use this function to replace the 'REContext' specified captures in each line matched
  | LineEdit !re           !(LineNo->Matches s->m (LineEdit s))
        -- ^ use this function to edit each line matched

-- | a LineEdit is the most general action thar can be performed on a line
-- and is the only means of deleting a line
data LineEdit s
  = NoEdit                  -- ^ do not edit this line but leave as is
  | ReplaceWith !s          -- ^ replace the line with this text (terminating newline should not be included)
  | Delete                  -- ^ delete the this line altogether
  deriving (Functor,Show)

-- | apply an 'Edits' script to each line of the argument text
sed' :: (IsRegex re a,Monad m,Functor m)
     => Edits m re a
     -> a
     -> m a
sed' escr t = do
  mconcat <$> sequence
    [ applyEdits lno escr s
        | (lno,s)<-zip [firstLine..] $ linesR t
        ]

-- | this function looks for lines of the form
--
--    `%include <file> [exclude <RE>]`
--
-- and replaces them with the contents of the named file, optionally
-- excluding any lines that match the given RE.
include :: LBS.ByteString -> IO LBS.ByteString
include = sed' $ Select
    [ Function [re|^%include ${file}(@{%string})$|]                              TOP incl
    , Function [re|^%include ${file}(@{%string}) *exclude *${rex}(@{%string})$|] TOP incl
    , Function [re|^.*$|]                                                        TOP nop
    ]
  where
    incl _ mtch _ _ = include' mtch
    nop  _ _    _ _ = return Nothing

-- | processes the match from a '%include' line, analyses the match,
-- fetches the file, optionally excludes lines specified by an RE,
-- returning the text to include.
include' :: Match LBS.ByteString -> IO (Maybe LBS.ByteString)
include' mtch = do
    ftr <- case prs_s <$> mtch !$$? [cp|rex|] of
      Nothing     -> return id
      Just re_lbs -> excl <$> makeRegex re_lbs
    Just . ftr <$> LBS.readFile (prs_s $ mtch !$$ [cp|file|])
  where
    excl :: RE -> LBS.ByteString -> LBS.ByteString
    excl rex =
        LBS.unlines . map (matchesSource . getLineMatches)
          . filter (not . anyMatches . getLineMatches)
          . grepFilter rex

    prs_s  = maybe (error "include'") T.unpack . parseString

-- | returns a 'Line' for each line in the argument text, enumerating
-- all of the matches for that line
grepFilter :: IsRegex re s => re -> s -> [Line s]
grepFilter rex = grepWithScript [(rex,mk)] . linesR
  where
    mk i mtchs = Just $ Line i mtchs

-- | 'grepLines' returns a 'Line' for each line in the file, listing all
-- of the 'Matches' for that line
data Line s =
  Line
    { getLineNumber  :: LineNo    -- ^ the 'LineNo' for this line
    , getLineMatches :: Matches s -- ^ all the 'Matches' of the RE on this line
    }
  deriving (Show)

-- | a simple regex-based scanner interpretter for prototyping
-- scanners
alex :: IsRegex re s => [(re,Match s->Maybe t)] -> t -> s -> [t]
alex = alex' matchOnce

-- | a higher order version of 'alex' parameterised over the @matchOnce@
-- function
alex' :: Replace s
      => (re->s->Match s)
      -> [(re,Match s->Maybe t)]
      -> t
      -> s
      -> [t]
alex' mo al t_err = loop
  where
    loop s = case lengthR s == 0 of
      True  -> []
      False -> choose al s

    choose []           _ = [t_err]
    choose ((re,f):al') s = case mb_p of
        Just (s',t) -> t : loop s'
        _           -> choose al' s
      where
        mb_p = do
          cap <- matchCapture mtch
          case captureOffset cap == 0 of
            True  -> (,) (captureSuffix cap) <$> f mtch
            False -> Nothing

        mtch = mo re s

-- | scan a RE string into a list of RE Token
scan :: String -> [Token]
scan = alex' match al $ oops "top"
  where
    al :: [(Regex,Match String->Maybe Token)]
    al =
      [ mk "\\$\\{([^{}]+)\\}\\(" $         ECap . Just . x_1
      , mk "\\$\\("               $ const $ ECap Nothing
      , mk "\\(\\?:"              $ const   PGrp
      , mk "\\(\\?"               $ const   PCap
      , mk "\\("                  $ const   Bra
      , mk "\\\\(.)"              $         BS    . s2c . x_1
      , mk "(.|\n)"               $         Other . s2c . x_1
      ]

    x_1     = captureText $ IsCaptureOrdinal $ CaptureOrdinal 1

    s2c [c] = c
    s2c _   = oops "s2c"

    mk s f  = (poss error id $ makeRegexM s,Just . f)

    oops  m = error $ "NamedCaptures.scan: " ++ m

-- | recursively list all files whose filename matches given RE,
-- sorting the list into ascending order; if the argument path has a
-- trailing '/' then it will be removed
findMatches_ :: IsRegex re s => FindMethods s -> re -> s -> IO [s]
findMatches_ fm = findMatches_' fm L.sort matched

-- | recursively list all files whose filename matches given RE,
-- using the given function to determine which matches to accept
findMatches_' :: IsRegex re s
              => FindMethods s         -- ^ the directory and filepath methods
              -> ([s]->[s])            -- ^ result post-processing function
              -> (Match s->Bool)       -- ^ filtering function
              -> re                    -- ^ re to be matched against the leaf filename
              -> s                     -- ^ root directory of the search
              -> IO [s]
findMatches_' fm srt tst re fp = srt <$> find_ fm tst re (packR "") fp

find_ :: IsRegex re s
      => FindMethods s
      -> (Match s->Bool)
      -> re
      -> s
      -> s
      -> IO [s]
find_ fm@FindMethods{..} tst re fn fp = do
  is_dir <- doesDirectoryExistDM fp
  case is_dir of
    True  -> do
      fns <- filter ordinary <$> listDirectoryDM fp
      concat <$>
        mapM (uncurry $ find_ fm tst re) [ (fn_,abs_path fn_) | fn_<-fns ]
    False -> return [ fp | lengthR fp /= 0 && tst (matchOnce re fn) ]
  where
    abs_path fn_ = fp `combineDM` fn_
    ordinary fn_ = not $ fn_ `elem` [packR ".",packR ".."]

sort_r :: Mode -> FilePath -> IO ()
sort_r md root = findMatches_ fm [re|\.l?hs|] root >>= sort_these md root
  where
    fm = FindMethods
      { doesDirectoryExistDM = doesDirectoryExist
      , listDirectoryDM      = getDirectoryContents
      , combineDM            = (</>)
      }