{-|
Description : Sample format definition for a style file
-}
module Language.Haskell.Formatter.Internal.StyleFileFormat (treeFormat) where
import qualified Data.Map as Map
import qualified Language.Haskell.Formatter as Formatter
import qualified Language.Haskell.Formatter.Internal.MapTree as MapTree
import qualified Language.Haskell.Formatter.Internal.TreeFormat as TreeFormat

treeFormat :: TreeFormat.TreeFormat Formatter.Style
treeFormat :: TreeFormat Style
treeFormat
  = [([Char], MapTree [Char] (Leaf Style))] -> TreeFormat Style
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [([Char]
"line_length_limit",
        Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
          \ Int
value Style
style -> Style
style{lineLengthLimit :: Int
Formatter.lineLengthLimit = Int
value}),
       ([Char]
"ribbons_per_line",
        Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Float Style -> Leaf Style)
-> RawLeaf Float Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Float Style -> Leaf Style
forall a. RawLeaf Float a -> Leaf a
TreeFormat.SingleFloating (RawLeaf Float Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Float Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
          \ Float
value Style
style -> Style
style{ribbonsPerLine :: Float
Formatter.ribbonsPerLine = Float
value}),
       ([Char]
"successive_empty_lines_limit",
        Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
          \ Int
value Style
style -> Style
style{successiveEmptyLinesLimit :: Int
Formatter.successiveEmptyLinesLimit = Int
value}),
       ([Char]
"indentations",
        TreeFormat Style -> MapTree [Char] (Leaf Style)
forall k a. MapForest k a -> MapTree k a
MapTree.Node (TreeFormat Style -> MapTree [Char] (Leaf Style))
-> TreeFormat Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
          [([Char], MapTree [Char] (Leaf Style))] -> TreeFormat Style
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [([Char]
"class",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{classIndentation :: Int
Formatter.classIndentation = Int
value}),
             ([Char]
"do",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{doIndentation :: Int
Formatter.doIndentation = Int
value}),
             ([Char]
"case",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{caseIndentation :: Int
Formatter.caseIndentation = Int
value}),
             ([Char]
"let",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{letIndentation :: Int
Formatter.letIndentation = Int
value}),
             ([Char]
"where",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{whereIndentation :: Int
Formatter.whereIndentation = Int
value}),
             ([Char]
"onside",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Int Style -> Leaf Style)
-> RawLeaf Int Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Int Style -> Leaf Style
forall a. RawLeaf Int a -> Leaf a
TreeFormat.LimitedInteger (RawLeaf Int Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Int Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Int
value Style
style -> Style
style{onsideIndentation :: Int
Formatter.onsideIndentation = Int
value})]),
       ([Char]
"order",
        TreeFormat Style -> MapTree [Char] (Leaf Style)
forall k a. MapForest k a -> MapTree k a
MapTree.Node (TreeFormat Style -> MapTree [Char] (Leaf Style))
-> TreeFormat Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
          [([Char], MapTree [Char] (Leaf Style))] -> TreeFormat Style
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
            [([Char]
"import_declarations",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Bool Style -> Leaf Style)
-> RawLeaf Bool Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Bool Style -> Leaf Style
forall a. RawLeaf Bool a -> Leaf a
TreeFormat.Boolean (RawLeaf Bool Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Bool Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Bool
value Style
style ->
                  Style
style{orderImportDeclarations :: Bool
Formatter.orderImportDeclarations = Bool
value}),
             ([Char]
"import_entities",
              Leaf Style -> MapTree [Char] (Leaf Style)
forall k a. a -> MapTree k a
MapTree.Leaf (Leaf Style -> MapTree [Char] (Leaf Style))
-> (RawLeaf Bool Style -> Leaf Style)
-> RawLeaf Bool Style
-> MapTree [Char] (Leaf Style)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawLeaf Bool Style -> Leaf Style
forall a. RawLeaf Bool a -> Leaf a
TreeFormat.Boolean (RawLeaf Bool Style -> MapTree [Char] (Leaf Style))
-> RawLeaf Bool Style -> MapTree [Char] (Leaf Style)
forall a b. (a -> b) -> a -> b
$
                \ Bool
value Style
style ->
                  Style
style{orderImportEntities :: Bool
Formatter.orderImportEntities = Bool
value})])]