{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms   #-}
{-# LANGUAGE ViewPatterns      #-}

module Blagda.Utils (getBuildPath, pattern Strs) where

import           Development.Shake.FilePath
import Data.Text (Text)
import Text.Pandoc (Inline(..))
import Control.Arrow ((&&&))

getBuildPath :: FilePath -> String -> FilePath -> FilePath
getBuildPath :: FilePath -> FilePath -> FilePath -> FilePath
getBuildPath FilePath
path FilePath
ext FilePath
x = FilePath
"_build" FilePath -> FilePath -> FilePath
</> FilePath
path FilePath -> FilePath -> FilePath
</> (FilePath -> FilePath
dropExtension (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeFileName FilePath
x) FilePath -> FilePath -> FilePath
<.> FilePath
ext

pattern Strs :: Text -> [Inline]
pattern $mStrs :: forall r. [Inline] -> (Text -> r) -> (Void# -> r) -> r
Strs ts <-
  ((id &&& id)
    ->
      ( all isStr -> True
      , foldMap fromStr -> ts
      )
  )

isStr :: Inline -> Bool
isStr :: Inline -> Bool
isStr (Str Text
_) = Bool
True
isStr Inline
Space = Bool
True
isStr Inline
_ = Bool
False

fromStr :: Inline -> Text
fromStr :: Inline -> Text
fromStr (Str Text
s) = Text
s
fromStr Inline
Space = Text
" "
fromStr Inline
_ = FilePath -> Text
forall a. HasCallStack => FilePath -> a
error FilePath
"not a string"