{-# LANGUAGE OverloadedStrings #-}

module Text.Internal.Cassius (i2bMixin) where

import qualified Data.Text.Lazy as TL
import Text.IndentToBrace (i2b)

i2bMixin :: String -> String
i2bMixin :: String -> String
i2bMixin String
s' =
    Text -> String
TL.unpack
        forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripEnd Text
"}"
        forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripFront Text
"mixin {"
        forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.strip
        forall a b. (a -> b) -> a -> b
$ String -> Text
TL.pack
        forall a b. (a -> b) -> a -> b
$ String -> String
i2b
        forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
        forall a b. (a -> b) -> a -> b
$ String
"mixin" forall a. a -> [a] -> [a]
: (forall a b. (a -> b) -> [a] -> [b]
map (String
"    " forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
s')
  where
    stripFront :: Text -> Text -> Text
stripFront Text
x Text
y =
        case Text -> Text -> Maybe Text
TL.stripPrefix Text
x Text
y of
            Maybe Text
Nothing -> Text
y
            Just Text
z -> Text
z
    stripEnd :: Text -> Text -> Text
stripEnd Text
x Text
y =
        case Text -> Text -> Maybe Text
TL.stripSuffix Text
x Text
y of
            Maybe Text
Nothing -> Text
y
            Just Text
z -> Text
z